VB常用算法代码

1、Feb数列前18项OptionBase1PrivateSubForm_Click()DimFeb(18)AsInteger,IAsIntegerFeb(1)=1Feb(2)=1ForI=3To18Feb(I)=Feb(I-1)+Feb(I-2)NextForI=1To18PrintFeb(I),IfIMod5=0ThenPrintNextEndSub鞍点OptionExplicitOptionBase1PrivateSubForm_Click()ClsDimA(4,5)AsInteger,IAsInteger,JAsInteger,KAsIntegerDimMaxAsInteger,MinAs

2、IntegerDimRowAsInteger,ColAsInteger,FlagAsBooleanRandomizeForI=1To4ForJ=1To5A(I,J)=Rnd*90+10PrintA(I,J);NextPrintNextI=1Flag=FalseDoWhileI<=4Max=A(I,1)Row=ICol=1ForJ=2To5IfMax<A(I,J)ThenMax=A(I,J)Row=ICol=JNextMin=MaxForK=1To4IfMin>A(K,Col)ThenI=I+1Flag=FalseExitForEndIfNextIfK=5ThenFlag=Tr

3、ueExitDoEndIfLoopIfNotFlagThenPrint”鞍点不存在！"ElsePrint”鞍点的位置："&CStr(Row)&"行”&CStr(Col)&"列"EndSub插入排序OptionBase1PrivateSubCommand1_Click()DimA(10)AsInteger,IAsInteger,JAsInteger,XAsIntegerClsPrint"排序前：”；ForI=1To10A(I)=Int(100*Rnd)PrintA(I);NextPrintForJ=2To

4、10X=A(J)I=J-1DoWhileX<A(I)A(I+1)=A(I)I=I-1IfI<1ThenExitDoLoopA(I+1)=XNextPrint"排序后："ForI=1To10PrintA(I);Next二分插入排序OptionBase1PrivateSubCommand1_Click()'二分插入排序DimA(10)AsInteger,IAsInteger,JAsInteger,XAsIntegerClsPrint"排序前：”；ForI=1To10A(I)=Int(100*Rnd)PrintA(I)；NextPrintDimFir

5、stAsInteger,LastAsInteger,MiddleAsIntegerDimKAsIntegerForJ=2To10X=A(J)First=1Last=J-1DoWhileFirst<=LastMiddle=(First+Last)/2IfX>A(Middle)ThenLast=Middle-1ElseFirst=Middle+1EndIfLoopForK=J-1ToMiddleStep-1A(K+1)=A(K)NextA(Middle)=XNextPrint"排序后："ForI=1To10PrintA(I);NextEndSub插入一个数到有序数列

6、DimA(10)AsInteger,IAsInteger,JAsIntegerPrivateSubCommand1_Click()DimXAsIntegerX=Textl.TextI=9DoWhileX<A(I)A(I+1)=A(I)I=I-1LoopA(I+1)=XPrint”插入数后：”；ForI=0To10PrintA(I)；NextPrintEndSubPrivateSubCommand2_Click()DimtempAsIntegerClsForI=0To9A(I)=Int(100*Rnd)NextForI=0To8ForJ=I+1To9IfA(I)>A(J)Thente

7、mp=A(I)A(I)=A(J)A(J)=tempEndIfNextNextPrint”有序序列："ForI=0To9PrintA(I);NextPrintText1.SetFocusEndSubPrivateSubForm_Activate()Print"将一个数插入到一个有序的序列中!EndSub查找子串位置OptionBase1PrivateSubCommand1_Click()DimS1AsString,S2AsString=Text1.Text=Text2.TextText3.Text=Index(S1,S2)EndSubPublicFunctionIndex(S

8、AsString,TAsString)AsIntegerDimIAsInteger,JAsIntegerDimLenSAsInteger,LenTAsIntegerLenS=LenB(S)LenT=LenB(T)I=1:J=1DoWhileI<=LenSAndJ<=LenTIfMidB(S,I,1)=MidB(T,J,1)ThenI=I+1J=J+1ElseI=I-J+2J=1EndIfLoopIfJ>LenTThenIndex=I-LenTElseIndex=0EndFunction自动出题OptionExplicitPublicAAsInteger,BAsInteger,

9、OptAsStringPublicCorrectAsInteger,WrongAsIntegerPrivateSubCommand1_Click()RandomizeDimCAsIntegerText1.Text=""A=Int(10*Rnd)+1B=Int(10*Rnd)+1C=Int(4*Rnd)SelectCaseCCase0:Opt="+'Case1:Opt="-"Case2:Opt="*"Case3:Opt="/"EndSelectLabell.Caption=ALabel2.Capti

10、on=OptLabel3.Caption=BLabel4.Visible=TrueText1.Visible=TrueText1.SetFocusEndSubPrivateSubCommand2_Click()DimResultAsIntegerSelectCaseOptCase"+":Result=A+BCase"-":Result=A-BCase"*”:Result=A*BCase"/":Result=A/BEndSelectIfResult=Val(Textl.Text)ThenMsgBox”很好，你做对了!"

11、;Picturel.PrintA&Opt&B&"="&Textl.Text&"V"Correct=Correct+1ElseMsgBox”好可惜，你错了！”Picturel.PrintA&Opt&B&"="&Textl.Text&"X"Wrong=Wrong+1EndIfEndSubPrivateSubCommand3_Click()MsgBox("你做对了"+CStr(Correct)+"题，做错了&qu

12、ot;+CStr(Wrong)+"题")EndSubPrivateSubForm_Activate()Command1.SetFocusLabel4.Visible=FalseText1.Visible=FalseEndSub打印ASIIC码PrivateSubForm_Click()DimIAsInteger,NAsIntegerN=1ForI=32To126PrintI;”:"Chr(I),IfN=5ThenN=1PrintElseN=N+1EndIfNextEndSub递归法Feb数列前10项PrivateSubForm_Click()DimIAsInteg

13、erForI=1To10PrintFeb(I)NextEndSubPrivateFunctionFeb(ByValNAsInteger)AsIntegerIfN=1ThenFeb=0ElseIfN=2ThenFeb=1ElseFeb=Feb(N-1)+Feb(N-2)EndIfEndFunction递归法逆转输出字符串PrivateSubForm_Click()DimSAsStringS=InputBox("Inputastring")InvertSEndSubPublicSubInvert(ByValSAsString)DimNAsIntegerN=Len(S)IfN=0

14、ThenExitSubElsePrintMid(S,N,1);S=Mid(S,1,N-1)InvertSEndIfEndSub递归法求最大公约数PrivateSubForm_Click()DimMAsInteger,NAsIntegerM=InputBox("M")N=InputBox("N")PrintM;N;"的最大公约数为："Gcd(M,N)EndSubPublicFunctionGcd(ByValMAsInteger,ByValNAsInteger)AsIntegerDimRAsIntegerR=MModNIfR=0ThenG

15、cd=NElseM=NN=RGcd=Gcd(M,N)EndIfEndFunction计算两个矩阵的积OptionBase1PrivateSubForm_Click()DimA(3,4)AsInteger,B(4,3)AsInteger,C(3,3)AsIntegerDimIAsInteger,JAsInteger,KAsIntegerPrint”矩阵A为："ForI=1To3ForJ=1To4A(I,J)=5*RndPrintA(I,J),NextPrintNextPrint”矩阵B为："ForI=1To4ForJ=1To3B(I,J)=5*RndPrintB(I,J),N

16、extPrintNextPrint”矩阵C为："ForI=1To3ForJ=1To3C(I,J)=0ForK=1To4C(I,J)=C(I,J)+A(I,K)*B(K,J)NextPrintC(I,J),NextPrintNextEndSub冒泡法排序OptionBase1PrivateSubForm_Click()DimA(10)AsInteger,IAsInteger,JAsInteger,TempAsIntegerForI=1To10A(I)=Int(90*Rnd)+10PrintA(I);NextPrintForI=9To1Step-1ForJ=1ToIIfA(J)>A

17、(J+1)ThenTemp=A(J)A(J)=A(J+1)A(J+1)=TempEndIfNextNextForI=1To10PrintA(I);NextEndSub逆序输出字符串PrivateSubForm_Click()DimCAsString,IAsIntegerC=InputBox("请输入一个字符串")PrintCForI=1ToLen(C)PrintMid(C,Len(C)-I+1,1);NextPrintEndSub牛顿迭代法PrivateSubCommand1_Click()DimxAsSingle,x1AsSingle,EpsAsSinglex=Input

18、Box("输入X的初始值",”牛顿迭代法")Eps=InputBox("输入允许的误差",”牛顿迭代法")Dox1=xx=x1-(x1*Exp(x1)-1)/(Exp(x1)*(x1+1)LoopUntilAbs(x-x1)<=EpsText1.Text=Str(x)EndSub求定积分PrivateSubForm_Click()DimAAsSingle,BAsSingle,NAsLongDimSAsDouble,HAsDouble,IAsLongN=InputBox("InputN")A=0B=1H=(B-

19、A)/NS=0ForI=0ToNS=S+(A+I*H)*HPrintSEndSub求组合数PrivateSubForm_Click()DimMAsInteger,NAsIntegerM=InputBox("M")N=InputBox("N")PrintFact(M)/(Fact(N)*Fact(M-N)EndSubPublicFunctionFact(NAsInteger)AsLongDimIAsIntegerFact=1ForI=1ToNFact=Fact*INextEndFunction人口增长PrivateSubCommand1_Click()Di

20、mXAsSingle,nAsLongX=Val(Text1.Text)n=0DoUntilX>=20X=X*(1+0.01)n=n+1LoopText2.Text=nEndSub筛选法排序OptionBase1PrivateSubForm_Click()DimA(10)AsInteger,IAsInteger,JAsInteger,TempAsIntegerPrint"排序前："ForI=1To10A(I)=Int(90*Rnd)+10PrintA(I);PrintForI=1To9ForJ=I+1To10IfA(I)>A(J)ThenTemp=A(I)A(I)

21、=A(J)A(J)=TempEndIfNextJNextIPrint"排序后：”；ForI=1To10PrintA(I)；NextPrintEndSub删除数列中重复的数OptionBase1PrivateSubForm_Click()DimA()AsInteger,IAsInteger,NAsIntegerDimJAsInteger,KAsInteger,UbAsIntegerRandomizeReDimA(10)ClsForI=1To10A(I)=Rnd*90+10PrintA(I)；NextPrintUb=UBound(A)I=1DoWhileI<=Ub-1J=I+1Do

22、WhileJ<=UbIfA(I)=A(J)ThenForK=JToUb-1A(K)=A(K+1)NextUb=Ub-1ReDimPreserveA(Ub)ElseEndIfLoopI=I+1LoopForI=1ToUBound(A)PrintA(I);NextPrintEndSub统计文件中字母出现的次数OptionExplicitOptionBase1PrivateSubCommand1_Click()DimChAsString,A(26)AsInteger,IAsIntegerDimFnameAsStringClscmDlg.ShowOpenFname=cmDlg.IfFname&l

23、t;>""ThenOpenFnameForInputAs#1'以Input方式打开文件，文件号为1ForI=1To26A(I)=0NextDoWhileNotEOF(1)Ch=Input$(1,1)'从文件中读取一个字符赋给变量ChForI=65To90'判断这个字符是什么IfUCase(Ch)=Chr(I)ThenA(I-64)=A(I-64)+1ExitForEndIfNextLoopForI=1To26PrintChr(I+64),A(I)NextClose#1'关闭所打开的文件ElsePrint”你没有打开文件！"En

24、dIfEndSubPrivateSubCommand2_Click()EndEndSub数据库操作PrivateSubcmdAdd_Click()IfcmdAdd.Caption="添加"ThenData1.Recordset.AddNewcmdAdd.Caption="确定"txtXh.Text=""txtXm.Text=""txtXb.Text=""txtNl.Text=""txtYx.Text=""RTF1.Text=""txtX

25、h.SetFocusElseData1.Recordset.Fields("xh")=txtXh.TextData1.Recordset.Fields("xm")=txtXm.TextData1.Recordset.Fields("xb")=txtXb.TextData1.Recordset.Fields("nl")=txtNl.TextData1.Recordset.Fields("yx")=txtYx.TextData1.Recordset.Fields("jl")=RT

26、F1.TextData1.Recordset.UpdatecmdAdd.Caption="添加"EndIfEndSubPrivateSubcmdDelete_Click()Data1.Recordset.DeleteData1.Recordset.MoveFirstEndSubPrivateSubcmdExit_Click()EndEndSubPrivateSubCommand1_Click()Data1.Recordset.MoveFirstEndSubPrivateSubCommand2_Click()DataI.Recordset.MovePreviousIfData

27、1.Recordset.BOF=TrueThenData1.Recordset.MoveFirstEndSubPrivateSubCommand3_Click()Data1.Recordset.MoveNextIfData1.Recordset.EOF=TrueThenData1.Recordset.MoveLastEndSubPrivateSubCommand4_Click()Data1.Recordset.MoveLastEndSub水仙花数PrivateSubForm_Click()DimIAsIntegerDimAAsInteger,BAsInteger,CAsIntegerForI=

28、1To999A=IMod10'个位C=I100'百位B=(I-C*100)10'十位IfI=AA3+BA3+CA3ThenPrintINextEndSub素数PrivateSubForm_Click()DimXAsInteger,IAsIntegerDimFlagAsBooleanX=InputBox("请输入一个自然数：")Flag=FalseIfX=2ThenPrintX;"是素数！"ElseForI=2ToX-1IfXModI<>0ThenFlag=TrueElseExitForEndIfNextIfFlagTh

29、enPrintX;"是素数！"ElsePrintX;"不是素数!EndIfEndSub质数PrivateSubForm_Click()DimJAsIntegerForJ=2To100IfPrime(J)ThenPrintJNextEndSubPublicFunctionPrime(nAsInteger)AsBooleanDimIAsIntegerPrime=TrueForI=2ToInt(n/2)Ifn<>2AndnModI=0ThenPrime=FalseExitForEndIfNextEndFunctionPublicFunctionPrime1(

30、nAsInteger)AsBooleanDimIAsIntegerForI=2ToInt(n/2)Ifn<>2AndnModI=0ThenExitForEndIfNextIfI>Int(n/2)ThenPrimel=TrueElsePrimel=FalseEndFunction随机文件学生信息OptionExplicitDimStudentAsRecordTypeDimStuInfoAsRecordTypeDimRecLenAsLong'记录长度DimRecNumAsLong'记录号PrivateSubCommand1_Click(),添加一条记录Studen

31、t.XH=txtXH.TextStudent.XM=txtXM.TextStudent.XB=cboXB.TextStudent.BJ=cboBJ.TextRecLen=Len(Student)Open"D:student.txt"ForRandomAs#1Len=RecLenRecNum=LOF(1)RecLen+1Put#1,RecNum,StudenttxtXH=""txtXM=""cboXB=""cboBJ=""txtXH.SetFocusRecNum=LOF(1)RecLentxtRe

32、cNo.ToolTipText="输入记录号。范围为：1"&CStr(RecNum)ResetEndSubPrivateSubCommand2_Click()'打印所有记录DimIAsLongPicture1.Cls'清空图像框RecLen=Len(Student)Open"D:student.txt"ForRandomAs#1Len=RecLenRecNum=LOF(1)RecLen+1ForI=1ToRecNumGet#1,I,StuInfoPicture1.PrintStuInfo.XH;StuInfo.XM;StuInfo

33、.XB;StuInfo.BJNextResetEndSubPrivateSubCommand3_Click()'修改指定记录号的记录DimIAsLongI=Int(Val(txtRecNo.Text)IfI<=0ThenMsgBox"请输入正确的记录号！",vbOKOnly,"Error"ElseRecLen=Len(Student)Open"D:student.txt"ForRandomAs#1Len=RecLenIfCommand3.Caption="修改"ThenCommand1.Enabled

34、=FalseCommand2.Enabled=FalseCommand4.Enabled=FalseCommand3.Caption="确定txtRecNo.Visible=FalseSeek#1,IGet#1,I,StuInfotxtXH.Text=StuInfo.XHtxtXM.Text=StuInfo.XMcboXB.Text=StuInfo.XBcboBJ.Text=StuInfo.BJElseCommand1.Enabled=TrueCommand2.Enabled=TrueCommand4.Enabled=TrueCommand3.Caption="修改txtR

35、ecNo.Visible=TrueStudent.XH=txtXH.TextStudent.XM=txtXM.TextStudent.XB=cboXB.TextStudent.BJ=cboBJ.TextPut#1,I,StudenttxtXH=""txtXM=""cboXB=""cboBJ=""txtXH.SetFocusEndIfEndIfResetEndSubPrivateSubCommand4_Click()'删除指定记录号的记录DimIAsLong,JAsLong,KAsLongI=Val(txtR

36、ecNo.Text)IfI=0ThenMsgBox"请输入记录号！",vbOKOnly,"Error"ElseRecLen=Len(Student)Open"D:student.txt"ForRandomAs#1Len=RecLenOpen"D:temp"ForRandomAs#2Len=RecLenDoWhileNotEOF(1)J=J+1Get#1,J,StudentIfJ<>IThenK=K+1Put#2,K,StudentEndIfLoopRecNum=LOF(2)RecLentxtRecNo.

37、ToolTipText="输入记录号。范围为：1"&CStr(RecNum)ResetKill"D:student.txt"'Name"d:temp"As"d:student.txt"EndIfEndSubPrivateSubForm_Load()RecLen=Len(Student)Open"D:student.txt"ForRandomAs#1Len=RecLenRecNum=LOF(1)RecLentxtRecNo.ToolTipText="输入记录号。范围为：1

38、"&CStr(RecNum)ResetEndSub同构数PrivateSubForm_Click()DimIAsLongForI=1To999SelectCaseICaseIs<=9And(I*I-I)Mod10=0:PrintI,IA2CaseIs<=99And(I*I-I)Mod100=0:PrintI,Ia2CaseIs<=999And(I*I-I)Mod1000=0:PrintI,Ia2EndSelectNextEndSub统计文本中字母出现的次数OptionBase1PrivateSubCommand1_Click()DimCh(26)AsInte

39、ger,IAsInteger,SAsString,JAsIntegerS=Text1.TextForI=1ToLen(S)IfAsc(UCase(Mid(S,I,1)>=65AndAsc(UCase(Mid(S,I,1)<=90ThenCh(Asc(UCase(Mid(S,I,1)-64)=Ch(Asc(UCase(Mid(S,I,1)-64)+1EndIfNextForI=1To26IfCh(I)>0ThenPrintChr(I+64);Ch(I),J=J+1IfJMod4=0ThenPrintEndIfNextEndSubPrivateSubText1_Click()Di

40、mNAsInteger,IAsIntegerRandomizeN=InputBox("请输入随机生成的字符数","统计字母个数")ForI=1ToNText1.Text=Text1.Text&Chr(Rnd*95+32)NextEndSub统计文本中字母个数PrivateSubForm_Click()DimSAsString,ChAsStringDimCount(65To90)AsIntegerDimIAsIntegerS=Text1.TextForI=1ToLen(S)Ch=UCase(Mid(S,I,1)IfCh<="Z&qu

41、ot;AndCh>="A"ThenCount(Asc(Ch)=Count(Asc(Ch)+1EndIfNextForI=65To90IfCount(I)>0ThenPrintChr(I),Count(I)NextEndSub完全数PrivateSubForm_Click()DimNAsInteger,IAsInteger,SAsIntegerN=InputBox("请输入一个整数",”完全数")S=0ForI=1ToN-1IfNModI=0ThenS=S+IEndIfNextIfS=NThenPrintN;"是完全数&qu

42、ot;ElsePrintN;"不是完全数"EndIfEndSub原码PrivateSubForm_Click()DimXAsInteger,SAsString,YAsInteger,IAsIntegerX=InputBox("Inputainteger:")Y=XS=""DoIfXMod2=0ThenS="0"&SElseS="1"&SEndIfX=X2LoopUntilX=0'整数用16位表示IfLen(S)<16ThenS=String(15-Len(S),"0")&SEndIf'补符号位IfY<0ThenS="1"&SElseS="0&qu