VB常用十大算法

1. 累加与连乘
1、算法说明
［分析］
累加形式：V=V+e 连乘形式：V=V*e
其中：V 是变量，e 是递增表达式。

累加和连乘一般通过循环结构来实现。

注意：需在执行循环体前对变量 V 赋初值。

一般累加时置初值0;连乘时置初值为1 ［举例］求N!的结果。

Private Sub Comma nd1_Click()
Dim n%, i%, s&
n = Val(InputBox("输入 n"))
s = 1
For i = 1 To n
s = s * i
Next i
Pr int s
End Sub
［应用举例］根据下列公式，求自然对数 e 的的近似值
Private Sub Comma nd1_Click()
Dim i%, n&, t!, e!
e = 2
i = 1
t = 1
Do While t > 0.00001
i = i + 1
t = t / i e = e + t
Loop
Print"计算了 "; i;"项目和是：";e
Print Exp(1)
与上句输出值进行对比以证明算法的正确性
End Sub
2. 最值问题
1、算法说明
=1 + 一_ + — +一 + 1! 2! 3! + 1 = 1 + -1
要求：误差小于0.00001
在若干数中求最大值，一般先取第一个数为最大值的初值(即假设第一个数为最大值)，然后，在循环体内将每一个数与最大值比较，若该数大于最大值，将该数替换为最大值，直到循环结束。

求最小值的方法类同。

求若干数平均值，实质上就是先求和，再除以这些数的个数。

应用举例：随机产生n个1-100 (包括1和100)的数，求它们的最大值、最小值和平均值。

Private Sub Comma nd1_Click()
Dim n%, i%, min%, max%, aver!, s%
n 二 Val(lnputBox("输入个数:"))
s = Int (Rnd * 100) + 1
max = s : min = s : aver = s
Print"第1个数是：” & s
For i = 2 To n
s = In t(R nd * 100) + 1
Print"第” & i & ” 个数是：” & s
If s > max The n max = s
If s < min The n min = s
aver = aver + s
Next i
aver = aver/n
Prin t "max="; max; " min二"；min; "aver二"；aver
End Sub
解题技巧：最大值、最小值、平均值类型题目往往和数组放在一起考！有的不仅求这些值，还要对具有最大值或者最小值的行或列或者某个元素进行处理，这时就要在记录最大、最小值时，同时记录该值所在的行号和列号。

3. 素数问题
1、算法说明
素数(质数)：就是一个大于等于2的整数，并且只能被1和本身整除，而不
能被其他整数整除的数。

判别某数m是否是素数的经典算法是：
对于m,从I = 2, 3, 4,……,m-1依次判别能否被I整除，只要有一个能整除，m就不是素数，否则m是素数。

Private Fun cti on sushu(ByVal n As In teger) As Boolea n
Dim i As In teger
For i = 2 To n - 1
If (n Mod i) = 0 The n Exit For
Next I
If I = n the n sushu二True
End Fun cti on
很显然，实际上，我们可以改进上面
Private Fun cti on sushu(ByVal n As In teger) As Boolea n
Dim i as In teger
For i = 2 to In t(Sqr( n))
If X Mod i = 0 The n Exit Fun ction
Next i
sushu = True
End Fun cti on
这样可以很好的提高效率。

以上判断是否为素数的代码务必识记！
应用举例：求100-200之内素数。

Private Sub Comma nd1_Click()
Dim j As In teger
For j = 100 To 200
If sushu(j) = True Then
Print j
End If
Next j
End Sub
实例说明
编程题：找出10000以内所有可以表示为两个平方数和的素数。

思路：首先找10000以内的所有素数，对于每个素数判断其是否可以表示为两个平方数之和(即对于任意小于该素数shu的数I，如果I和shu- I均为平方数，则说明
其可以表示为两个平方数之和。

)
判断数I是否为平方数的方法：Sqr(i) = Int(Sqr(i))
Private Sub Comma nd1_Click()
Dim j As In teger, m Asin teger, n As In teger
For j = 2 To 10000
If sushu(j) = True Then
If pf(j, m, n)二 True The n Listl.Addltem j & "二"& m & "+" & n
End If
End If
Next j
End Sub
Private Fun cti on pf(ByVal shu As In teger, m As In teger, n As In teger) As Boolea n Dim i As Long
For i = 1 To shu - 1
If (Sqr(i) = In t(Sqr(i))) And (Sqr(shu - i) = In t(Sqr(shu - i))) The n pf = True m = i
n 二 shu - i
Exit Fun cti on
End If
Next
End Fun cti on
4. 进制转换
1、算法说明
1) 十进制正整数m转换为R (2- 16)进制的字符串。

思路：将m不断除r取余数，直到商为0,将余数反序即得到结果。

算法实现：
Private Fun cti on Tran( ByVai m As In teger, ByVai r As In teger) As Stri ng Dim StrDtoR As Stri ng, n As In teger
Do While m <> o
n 二 m Mod r
m = m \ r
If n > 9 The n
StrDtoR = Chr(65 + n - 10) & StrDtoR
Else
StrDtoR = n & StrDtoR
End If
Loop
Tran 二 StrDtoR
End Fun cti on
2) R( 2- 16)进制字符串转换为十进制正整数。

思路：R进制数每位数字乘以权值之
和即为十进制数。

算法实现：
Private Fun cti on Tran( ByVai s As Str ing, ByVai r As In teger) As In teger Dim i as In teger, n As In teger, dec As In teger
s = UCase(Trim(s))
For i = 1 To Len(s)
If Mid(s, i, 1) >= "A" The n
n 二 Asc(Mid(s, i, 1)) - Asc("A") + 10
Else
n 二 Val(Mid(s, i, 1))
End If
dec = dec + n * r 八(Le n(s) - i)
Next i
Tran 二 dec
End Fun cti on
解题技巧：进制转化的原理要清楚，同时编写代码时候要留意16进制中的A - F字符的处理。

算法(五)约数因子--
5. 最大公约数、最小公倍数
1、算法说明
1)最大公约数：用辗转相除法求两自然数 m 、n 的最大公约数。

(1) 首先，对于已知两数 m 、n ,比较并使得m>n ;
(2) m 除以n 得余数r ;
(3) 若r = 0,则n 为求得的最大公约数，算法结束；否则执行步骤 ⑷
(4) m n nr 再重复执行(2) 分析步骤：10与5
m = 10, n 二 5 r = m Mod n 二 0 所以n(n=5)为最大公约数 算法实现：循环
Private Function GCD(ByVal m As Long, ByVai n As Long) As Long Dim temp As
Long, r As Long
If m < n The n temp = m: m = n: n 二 temp
Do
r = m Mod n
If r = 0 Then Exit Do m = n
n 二 r
Loop
GCD = n
End Fun cti on
Private Function GCD(ByVal m As Long, ByVai
n As Long) As Long
Dim temp As Long, r As Long
If m < n The n temp = m: m = n: n 二 temp
r = m Mod n
If r = 0 The n
GCD = n
Else
m = n
n 二 r
GCD = GCD( m, n)
End If
End Fun cti on
2) 最小公倍数：mx n 眾大公约数
3) 互质数：最大公约数为1的两个正整数
解题技巧：该算法需要识记！这种类型题目的扩展是 约数和因子题型
分析步骤：m 二24, n 二9
24 与 9 r = m Mod n 二 6 20, m = 9, n 二 6 r = m Mod n 二 3 20, m = 6, n 二 3 r = m Mod n 二 0 3
为最大公约数。

算法实现：递归
6.排序
1、算法说明
1)选择法排序
(1) 从n 个数中选出最小数的下标，出了循环，将最小数与第一个数交换位置；
(2) 除第一个数外，在剩下的n-1个数中再按方法(1)选出次小的数，与第二个 数交换位置；
(3) 以此类推，最后构成递增序列。

8 6 9 3 2 7
2 6 9
3 8 7
2 3 9 6 8 7
2 3 6 9 8 7
2 3 6 7 8 9
2 3 6 7 8 9
程序代码如下：
Private Sub xzPaiXu(a() As Double, she ng As Boolea n)
'a 为需要排序的数组，she ng 为True 则为升序排列，为False,则为降序排列。

Dim i As In teger, j As In teger, temp As Double, m As In teger
For i = LBound(a) To UBound(a) - 1 '进行数组大小-1 轮比较
m = i '在第i 轮比较时，假定第i 个元素为最值元素
For j = i + 1 To UBou nd(a) '在剩下的元素中找出最值元素的下标并赋值给
If she ng The n '若为升序，则m 记录最小元素下标，否则记录最大元素下标
If a(j)
< a(m) The n m = j
Else
If a(j) > a(m) The n m = j
End If
Next j
temp = a(i): a(i) = a(m): a(m) = temp '将最值元素与第i 个元素交换
Next i
End Sub
调用该过程示例：
Optio n Base 1
Private Sub Comma nd1_Click()
Dim b(6) As Double
b(1) = 8 : b(2) = 6 : b(3) = 9 : b(4) = 3 : b(5) = 2 : b(6) = 7
Call xzPaiXu(b, True)
For i% = 1 To 6
Print b(i)
Next
End Sub
譬如： 第一轮交换后 第二轮交换后 第三轮交换后 第四轮交换后 第五轮无交换
2)冒泡法排序
选择排序法在每一轮排序时找最值元素的下标，出了内循环(一轮排序结束)，再 交换最小数的位置；而冒泡法在每一轮排序时将相邻的数比较，当次序不对就交换 位置，出了内循环，最值数已经冒出。

程序代码如下:
Private Sub mpPaiXu(a() As Double, she ng As Boolea n)
'a 为需要排序的数组，she ng 为True 则为升序排列，为False,贝卩为降序排列 Dim i As In teger, j As In teger, temp As Double
For i = LBou nd(a) To UBou nd(a) - 1 For j = UBou nd(a) To i + 1 Step -1 If she ng Then If a(j) < a(j - 1) Then
temp = a(j) : a(j) = a(j - 1) : a(j - 1) = temp End If
Else
If a(j) > a(j - 1) The n temp = a(j) : a(j) = a(j - 1) : a(j - 1) = temp
End If
End If
Next j '出了内循环，一轮排序结束，最值元素冒到最上边
Next i
End Sub
数组元素插入删除--
7 7 2 2 3 3 9 9 6 6
第一轮排序： 、 从右至左将最小的数 移至最右边。

7 7 3- 3 2- 9 9 2 6 6
8 8 7 7 3 3 9 9 6- 6 2- 8
7 9 9 7 6 8 8
6
3 3 9 9
8 8 7 7 6 6 3 3 进行n-1轮比较
'从n 到i 个元素两两进行比较 '若次序不对，马上进行交换
7.在数组中插入或删除元素
1、算法说明
数组中元素的插入和删除一般是在已固定序列的数组中插入或删除一个元素，使得插入或删除操作后的数组还是有序的。

基本思路：首先要找到插入位置或要删除的元素。

1）插入
代码如下：
Private Sub Comma nd1_Click()
Dim a(10) As In teger, i As In teger, k As In teger
For i = 0 To 9 '生成数组
a(i) = i * 3 + 1
Print a(i);
Next i
Print
Print"插入14"
For k = 0 To 9 '查找插入14在数组中的位置
If 14 < a(k) Then Exit For
Next k
For i = 9 To k Step -1从最后元素开始逐个后移，腾出位置
a(i + 1) = a(i)
Next i
a(k) = 14 插入数14
For i = 0 To 10
Print a(i);
Next i
Print
End Sub
2)删除
1 4 7 10 13 16 19 2
2 25 28
K
110131619222恥
io
码如
下：Dim a() as in teger
ReDim a(1 to n)
For i=k+1 to n a(i-1)=a(i)
Next I
Redim preserve a(1 to n-
1)
8.查找
1、算法说明
1)顺序查找 逐个元素找，如果有，则记录位置，然后跳出循环；否则，查找失败。

代码如下：
Private Sub Search(a(), ByVai Key, I ndex As In teger)
Dim i%
For i = LBo un d(a) To UBoun d(a)
If a(i) = Key Then '找到了，将元素下标保存在index 中并结束查找
In dex = i
Exit Sub
End If
Next i
Index = -1 '若没找到，则index 值为-1
End Sub 2)二分法查找
顺序查找效率低下，当数组有序排列时，可以使用二分法查找提高效率。

代码如下： Private Sub birSearch(a(), ByVal low%, ByVal high%, ByVal Key, i ndex%)
Private Sub Comma nd1_Click()
Dim a(11), i nd As In teger
a(1) = 5: a(2) = 13: a(3) = 19: a(4) = 21: a(5) = 37
a(6) = 56: a(7) = 64: a(8) = 75: a(9) = 80: a(10) = 88: a(11) = 92
Call birSearch(a, LBou nd(a), UBou nd(a), 21, i nd)
Print ind
End Sub
9.数学表达式
1、算法说明
1)初等数学 递推法 又称为迭代法”，其基本思想是把一个复杂的计算过程转化为简单过程
的多次重 复。

每次重复都在旧值的基础上递推出新值，并由新值代替旧值。

Dim mid As In teger If low > high
The n in dex = -1
Exit Sub
End If mid = (low + high) \ 2
If Key = a(mid) The n
in dex = mid
Exit Sub ElseIf Key < a(mid) The n
high = mid - 1 Else
low = mid + 1 End If
Call birSearch(a, low, high, Key, in dex) End Sub
调用方法：
'没有查找到 '取查找区间的中点 查找到，返回下标 '查找区间在上半部分 '查找区间在下半部分 '递归调用查找函数
问题：猴子吃桃子
小猴子有若干桃子，第一天吃掉一半多一个；第二天吃掉剩下的一半多一个…..; 如此，到第七天早上要吃时，只剩下一个桃子。

问小猴子一开始共有多少桃子？分析：可以最后一天桃子数推出倒数第二天的桃子数；再从倒数第二天推出倒数第三天桃子数
设第n天桃子数为X n,前一天桃子数是：X n-1,则有关系：
X n = X n-1/2-1
程序如下：
Private Sub Comma nd1_Click()
Dim n %, i% -
x = 1 '第七天桃子数
Print"第七天桃子数：1只"
For i = 6 To 1 Step -1
x = (x + 1) * 2 Print "第” & i & ”天桃子数:"& x & ”只”
Next i
End Sub
穷举法
又称枚举法，即将所有可能情况一一测试，判断是否满足条件，一般用循环实现。

问题：百元买鸡问题。

假定小鸡每只5角；公鸡每只2元；母鸡每只3元。

现在有100元，要求买100只鸡，编程列出所有可能的购鸡方案。

分析：设母鸡、公鸡、小鸡分别x、y、z只，则有：
x + y + z= 100 3x+2y+ 0.5z= 100
程序一：
Private Sub Comma nd1_Click()
Dim x%, y%, z%
For x = 0 To 100
For y = 0 To 100
For z = 0 To 100
If x + y + z = 100 And 3 * x + 2 * y + 0.5 * z = 100 The n Print x, y, z
End If
Next z
Next y
Next x
End Sub
程序二(优化)
Private Sub Comma nd1_Click()
Dim x%, y%
For x = 0 To 33
For y = 0 To 50
If 3 * x + 2 * y + 0.5 * (100 - x - y) = 100 Then Print x, y, 100 - x - y
End If
Next y
Next x
End Sub
2)高等数学求积分
近似计算积分：s = / 13(x3+2x+5)dx 代码如下：
Public Function f(ByVal x!)'被积函数f = x * (x * x + 2) + 5
End Fun cti on
Public Fun ction trapez(ByVal a!, ByVal b!, ByVal n%) As Sin gle 'b、a分别为积分上下限，n为等分数
Dim sum!, h!, x!
h = (b - a) / n
sum = (f(a) + f(b)) / 2
For i = 1 To n - 1
x = a + i * h sum = sum + f(x)
Next i
trapez = sum * h
End Fun cti on
调用：
Private Sub Comma nd1_Click()
Print trapez(1,3, 30)
End Sub
10.字符串处理
1、算法说明
1)加密解密：最简单的加密方法是：将每个字母加一序数，例如5,这时：
A — F , a — f ,
B — G , b 宀g ..................................................................... Y 宀D -”『解密是加密的逆操作。

Optio n Explicit
Private Sub Comma nd1_Click()
Dim strlnput$, Code$, Record$, c As String * 1
Dim i%, le ngth%, iAsc% strl nput = Textl.Text len gth = Len( Trim(strl nput))
Code =""
For i = 1 To len gth
c = mid(strl nput, i, 1)
Select Case c
Case "A" To "Z"
iAsc = Asc(c) + 5
If iAsc > Asc("Z") The n iAsc
= iAsc - 26
Code = Code & Chr(iAsc)
Case "a" To "z"
iAsc = Asc(c) + 5
If iAsc > Asc("z") Then iAsc = iAsc - 26
Code = Code & Chr(iAsc)
Case Else
Code = Code & c
End Select
Next i
Text2.Text = Code
End Sub
2)统计：统计字符或者数字出现的次数。

算法说明：以字符统计为例，设基本问题如下：请统计一段文本中英文字母在文本中出现的次数。

(不区分大小写)
如: I am a student.得到：A:2 d:1 e:1 l:1 m:1 n:1 s:1 t:2 u:1
分析：由于不区分大小写，因此可定义一个大小为26(下标：0—25)的数组,
每个元素依次记录A、B、C…Z字母出现的次数。

A(0)存放字母a出现的次数
A(1)存放字母b出现的次数
A(2)存放字母c出现的次数
代码如下：
Optio n Explicit
Private Sub Comma nd1_Click()
Dim i As Integer, j As Integer, zimu(25) As Integer, allStr As String, aStr As String allStr = UCase(Textl.Text)
For i = 1 To Len (Textl.Text)
aStr = Mid(allStr, i, 1)
If aStr >= "A" And aStr <= "Z" The n
zimu(Asc(aStr) - Asc("A")) = zimu(Asc(aStr) - Asc("A")) + 1 End If Next i
For i = 0 To 25
If zimu(i) <> 0 The n
j = j + 1
Text2.Text = Text2.Text & Chr(i + Asc("A")) & ":" & str(zimu(i)) & "" If j Mod 5 =
0 The n Text2.Text = Text2.Text & Chr(13) & Chr(10)
End If
Next i
End Sub
解题技巧：熟练运用字符处理函数，对于一些数论题，譬如逆序数等也可将数字通过CStr函数转换为字符后，利用字符处理函数来解题。