VB常用算法代码.docx

VB常用算法代码.docx

《VB常用算法代码.docx》由会员分享，可在线阅读，更多相关《VB常用算法代码.docx（35页珍藏版）》请在冰豆网上搜索。

VB常用算法代码

Feb数列前18项

OptionBase1

PrivateSubForm_Click（）

DimFeb（18）AsInteger,IAsInteger

Feb

（1）=1

Feb

（2）=1

ForI=3To18

Feb（I）=Feb（I-1）+Feb（I-2）

Next

ForI=1To18

PrintFeb（I）,

IfIMod5=0ThenPrint

Next

EndSub

鞍点

OptionExplicit

OptionBase1

PrivateSubForm_Click（）

Cls

DimA（4,5）AsInteger,IAsInteger,JAsInteger,KAsInteger

DimMaxAsInteger,MinAsInteger

DimRowAsInteger,ColAsInteger,FlagAsBoolean

Randomize

ForI=1To4

ForJ=1To5

A（I,J）=Rnd*90+10

PrintA（I,J）;

Next

Print

Next

I=1

Flag=False

DoWhileI<=4

Max=A（I,1）

Row=I

Col=1

ForJ=2To5

IfMax

Max=A（I,J）

Row=I

Col=J

EndIf

Next

Min=Max

ForK=1To4

IfMin>A（K,Col）Then

I=I+1

Flag=False

ExitFor

EndIf

Next

IfK=5Then

Flag=True

ExitDo

EndIf

Loop

IfNotFlagThenPrint"鞍点不存在！

"ElsePrint"鞍点的位置：

"&CStr（Row）&"行"&CStr（Col）&"列"

EndSub

插入排序

OptionBase1

PrivateSubCommand1_Click（）

DimA（10）AsInteger,IAsInteger,JAsInteger,XAsInteger

Cls

Print"排序前：

";

ForI=1To10

A（I）=Int（100*Rnd）

PrintA（I）;

Next

Print

ForJ=2To10

X=A（J）

I=J-1

DoWhileX

A（I+1）=A（I）

I=I-1

IfI<1ThenExitDo

Loop

A（I+1）=X

Next

Print"排序后：

";

ForI=1To10

PrintA（I）;

Next

EndSub

二分插入排序

OptionBase1

PrivateSubCommand1_Click（）

'二分插入排序

DimA（10）AsInteger,IAsInteger,JAsInteger,XAsInteger

Cls

Print"排序前：

";

ForI=1To10

A（I）=Int（100*Rnd）

PrintA（I）;

Next

Print

DimFirstAsInteger,LastAsInteger,MiddleAsInteger

DimKAsInteger

ForJ=2To10

X=A（J）

First=1

Last=J-1

DoWhileFirst<=Last

Middle=（First+Last）/2

IfX>A（Middle）Then

Last=Middle-1

Else

First=Middle+1

EndIf

Loop

ForK=J-1ToMiddleStep-1

A（K+1）=A（K）

Next

A（Middle）=X

Next

Print"排序后：

";

ForI=1To10

PrintA（I）;

Next

EndSub

插入一个数到有序数列

DimA（10）AsInteger,IAsInteger,JAsInteger

PrivateSubCommand1_Click（）

DimXAsInteger

X=Text1.Text

I=9

DoWhileX

A（I+1）=A（I）

I=I-1

Loop

A（I+1）=X

Print"插入数后：

";

ForI=0To10

PrintA（I）;

Next

Print

EndSub

PrivateSubCommand2_Click（）

DimtempAsInteger

Cls

ForI=0To9

A（I）=Int（100*Rnd）

Next

ForI=0To8

ForJ=I+1To9

IfA（I）>A（J）Then

temp=A（I）

A（I）=A（J）

A（J）=temp

EndIf

Next

Next

Print"有序序列：

";

ForI=0To9

PrintA（I）;

Next

Print

Text1.SetFocus

EndSub

PrivateSubForm_Activate（）

Print"将一个数插入到一个有序的序列中！

"

EndSub

查找子串位置

OptionBase1

PrivateSubCommand1_Click（）

DimS1AsString,S2AsString

S1=Text1.Text

S2=Text2.Text

Text3.Text=Index（S1,S2）

EndSub

PublicFunctionIndex（SAsString,TAsString）AsInteger

DimIAsInteger,JAsInteger

DimLenSAsInteger,LenTAsInteger

LenS=LenB（S）

LenT=LenB（T）

I=1:

J=1

DoWhileI<=LenSAndJ<=LenT

IfMidB（S,I,1）=MidB（T,J,1）Then

I=I+1

J=J+1

Else

I=I-J+2

J=1

EndIf

Loop

IfJ>LenTThenIndex=I-LenTElseIndex=0

EndFunction

自动出题

OptionExplicit

PublicAAsInteger,BAsInteger,OptAsString

PublicCorrectAsInteger,WrongAsInteger

PrivateSubCommand1_Click（）

Randomize

DimCAsInteger

Text1.Text=""

A=Int（10*Rnd）+1

B=Int（10*Rnd）+1

C=Int（4*Rnd）

SelectCaseC

Case0:

Opt="+"

Case1:

Opt="-"

Case2:

Opt="*"

Case3:

Opt="/"

EndSelect

Label1.Caption=A

Label2.Caption=Opt

Label3.Caption=B

Label4.Visible=True

Text1.Visible=True

Text1.SetFocus

EndSub

PrivateSubCommand2_Click（）

DimResultAsInteger

SelectCaseOpt

Case"+":

Result=A+B

Case"-":

Result=A-B

Case"*":

Result=A*B

Case"/":

Result=A/B

EndSelect

IfResult=Val（Text1.Text）Then

MsgBox"很好，你做对了!

"

Picture1.PrintA&Opt&B&"="&Text1.Text&"V"

Correct=Correct+1

Else

MsgBox"好可惜，你错了！

"

Picture1.PrintA&Opt&B&"="&Text1.Text&"X"

Wrong=Wrong+1

EndIf

EndSub

PrivateSubCommand3_Click（）

MsgBox（"你做对了"+CStr（Correct）+"题，做错了"+CStr（Wrong）+"题"）

EndSub

PrivateSubForm_Activate（）

Command1.SetFocus

Label4.Visible=False

Text1.Visible=False

EndSub

打印ASIIC码

PrivateSubForm_Click（）

DimIAsInteger,NAsInteger

N=1

ForI=32To126

PrintI;":

";Chr（I）,

IfN=5Then

N=1

Print

Else

N=N+1

EndIf

Next

EndSub

递归法Feb数列前10项

PrivateSubForm_Click（）

DimIAsInteger

ForI=1To10

PrintFeb（I）

Next

EndSub

PrivateFunctionFeb（ByValNAsInteger）AsInteger

IfN=1Then

Feb=0

ElseIfN=2Then

Feb=1

Else

Feb=Feb（N-1）+Feb（N-2）

EndIf

EndFunction

递归法逆转输出字符串

PrivateSubForm_Click（）

DimSAsString

S=InputBox（"Inputastring"）

InvertS

EndSub

PublicSubInvert（ByValSAsString）

DimNAsInteger

N=Len（S）

IfN=0Then

ExitSub

Else

PrintMid（S,N,1）;

S=Mid（S,1,N-1）

InvertS

EndIf

EndSub

递归法求最大公约数

PrivateSubForm_Click（）

DimMAsInteger,NAsInteger

M=InputBox（"M"）

N=InputBox（"N"）

PrintM;N;"的最大公约数为：

";Gcd（M,N）

EndSub

PublicFunctionGcd（ByValMAsInteger,ByValNAsInteger）AsInteger

DimRAsInteger

R=MModN

IfR=0Then

Gcd=N

Else

M=N

N=R

Gcd=Gcd（M,N）

EndIf

EndFunction

计算两个矩阵的积

OptionBase1

PrivateSubForm_Click（）

DimA（3,4）AsInteger,B（4,3）AsInteger,C（3,3）AsInteger

DimIAsInteger,JAsInteger,KAsInteger

Print"矩阵A为：

"

ForI=1To3

ForJ=1To4

A（I,J）=5*Rnd

PrintA（I,J）,

Next

Print

Next

Print"矩阵B为：

"

ForI=1To4

ForJ=1To3

B（I,J）=5*Rnd

PrintB（I,J）,

Next

Print

Next

Print"矩阵C为：

"

ForI=1To3

ForJ=1To3

C（I,J）=0

ForK=1To4

C（I,J）=C（I,J）+A（I,K）*B（K,J）

Next

PrintC（I,J）,

Next

Print

Next

EndSub

冒泡法排序

OptionBase1

PrivateSubForm_Click（）

DimA（10）AsInteger,IAsInteger,JAsInteger,TempAsInteger

ForI=1To10

A（I）=Int（90*Rnd）+10

PrintA（I）;

Next

Print

ForI=9To1Step-1

ForJ=1ToI

IfA（J）>A（J+1）Then

Temp=A（J）

A（J）=A（J+1）

A（J+1）=Temp

EndIf

Next

Next

ForI=1To10

PrintA（I）;

Next

EndSub

逆序输出字符串

PrivateSubForm_Click（）

DimCAsString,IAsInteger

C=InputBox（"请输入一个字符串"）

PrintC

ForI=1ToLen（C）

PrintMid（C,Len（C）-I+1,1）;

Next

Print

EndSub

牛顿迭代法

PrivateSubCommand1_Click（）

DimxAsSingle,x1AsSingle,EpsAsSingle

x=InputBox（"输入X的初始值","牛顿迭代法"）

Eps=InputBox（"输入允许的误差","牛顿迭代法"）

Do

x1=x

x=x1-（x1*Exp（x1）-1）/（Exp（x1）*（x1+1））

LoopUntilAbs（x-x1）<=Eps

Text1.Text=Str（x）

EndSub

求定积分

PrivateSubForm_Click（）

DimAAsSingle,BAsSingle,NAsLong

DimSAsDouble,HAsDouble,IAsLong

N=InputBox（"InputN"）

A=0

B=1

H=（B-A）/N

S=0

ForI=0ToN

S=S+（A+I*H）*H

Next

PrintS

EndSub

求组合数

PrivateSubForm_Click（）

DimMAsInteger,NAsInteger

M=InputBox（"M"）

N=InputBox（"N"）

PrintFact（M）/（Fact（N）*Fact（M-N））

EndSub

PublicFunctionFact（NAsInteger）AsLong

DimIAsInteger

Fact=1

ForI=1ToN

Fact=Fact*I

Next

EndFunction

人口增长

PrivateSubCommand1_Click（）

DimXAsSingle,nAsLong

X=Val（Text1.Text）

n=0

DoUntilX>=20

X=X*（1+0.01）

n=n+1

Loop

Text2.Text=n

EndSub

筛选法排序

OptionBase1

PrivateSubForm_Click（）

DimA（10）AsInteger,IAsInteger,JAsInteger,TempAsInteger

Print"排序前：

";

ForI=1To10

A（I）=Int（90*Rnd）+10

PrintA（I）;

Next

Print

ForI=1To9

ForJ=I+1To10

IfA（I）>A（J）Then

Temp=A（I）

A（I）=A（J）

A（J）=Temp

EndIf

NextJ

NextI

Print"排序后：

";

ForI=1To10

PrintA（I）;

Next

Print

EndSub

删除数列中重复的数

OptionBase1

PrivateSubForm_Click（）

DimA（）AsInteger,IAsInteger,NAsInteger

DimJAsInteger,KAsInteger,UbAsInteger

Randomize

ReDimA（10）

Cls

ForI=1To10

A（I）=Rnd*90+10

PrintA（I）;

Next

Print

Ub=UBound（A）

I=1

DoWhileI<=Ub-1

J=I+1

DoWhileJ<=Ub

IfA（I）=A（J）Then

ForK=JToUb-1

A（K）=A（K+1）

Next

Ub=Ub-1

ReDimPreserveA（Ub）

Else

J=J+1

EndIf

Loop

I=I+1

Loop

ForI=1ToUBound（A）

PrintA（I）;

Next

Print

EndSub

统计文件中字母出现的次数

OptionExplicit

OptionBase1

PrivateSubCommand1_Click（）

DimChAsString,A（26）AsInteger,IAsInteger

DimFnameAsString

Cls

cmDlg.ShowOpen

Fname=cmDlg.

IfFname<>""Then

OpenFnameForInputAs#1'以Input方式打开文件，文件号为1

ForI=1To26

A（I）=0

Next

DoWhileNotEOF

（1）

Ch=Input$（1,1）'从文件中读取一个字符赋给变量Ch

ForI=65To90'判断这个字符是什么

IfUCase（Ch）=Chr（I）Then

A（I-64）=A（I-64）+1

ExitFor

EndIf

Next

Loop

ForI=1To26

PrintChr（I+64）,A（I）

Next

Close#1'关闭所打开的文件

Else

Print"你没有打开文件！

"

EndIf

EndSub

PrivateSubCommand2_Click（）

End

EndSub

数据库操作

PrivateSubcmdAdd_Click（）

IfcmdAdd.Caption="添加"Then

Data1.Recordset.AddNew

cmdAdd.Caption="确定"

txtXh.Text=""

txtXm.Text=""

txtXb.Text=""

txtNl.Text=""

txtYx.Text=""

RTF1.Text=""

txtXh.SetFocus

Else

Data1.Recordset.Fields（"xh"）=txtXh.Text

Data1.Recordset.Fields（"xm"）=txtXm.Text

Data1.Recordset.Fields（"xb"）=txtXb.Text

Data1.Recordset.Fields（"nl"）=txtNl.Text

Data1.Recordset.Fields（"yx"）=txtYx.Text

Data1.Recordset.Fields（"jl"）=RTF1.Text

Data1.Recordset.Update

cmdAdd.Caption="添加"

EndIf

EndSub

PrivateSubcmdDelete_Click（）

Data1.Recordset.Delete

Data1.Recordset.MoveFirst

EndSub

PrivateSubcmdExit_Click（）

End

EndSub

PrivateSubCommand1_Click（）

Data1.Recordset.MoveFirst

EndSub

PrivateSubCommand2_Click（）

Data1.Recordset.MovePrevious

IfData1.Recordset.BOF=TrueThenData1.Recordset.MoveFirs