VB程序设计的常用算法09

Visual Basic常用算法

从逻辑结构上看，应用程序= 算法+ 数据结构。

（1）数据结构（Data-Structure），计算机将数据元素依据某种逻辑联系进行存储和组织的方式。

许多大型系统的构造经验表明，系统实现的困难程度和系统构造的质量都严重依赖于是否选择了最优的数据结构。选择了数据结构，算法也随之确定，是数据而不是算法是系统构造的关键因素。这种洞见导致了许多种软件设计方法和程序设计语言的出现，面向对象的程序设计语言就是其中之一。

数据是对客观事物的符号表示，在计算机科学中是指所有能输入到计算机中并由计算机程序处理的符号的总称。

（2）算法（Algorithm），由基本运算及规定的运算顺序所构成的完整解题步骤。

一个算法应该具有以下五个重要的特征：

①有穷性，算法必须保证执行有限步之后结束。

②确切性，算法的每一步骤必须有确切的定义。

③输入，算法有0个或多个输入，以描述运算量的初始值。0个输入是指算法本身包含了初始值。

④输出，算法有一个或多个输出，以反映对输入数据加工后的结果。没有结果的算法是毫无意义的。

⑤可行性，算法原则上能够精确地运行，而且人们用笔和纸做有限次运算后即可完成。

计算机科学家尼克劳斯-沃思曾著过一本著名的书《数据结构十算法= 程序》，可见算法在计算机科学界与计算机应用界的地位。

算法的描述：是对要解决一个问题或要完成一项任务所采取的方法和步骤的描述，包括需要什么数据（输入什么数据、输出什么结果）、采用什么结构、使用什么语句以及如何安排这些语句等。

程序（Programme）就是用计算机语言描述的算法。流程图（Flow Charts）就是图形化的算法。解决同一问题可以有多种算法描述。实际问题的算法种类繁多，总体上可以分为两大类：数值算法和非数值法。

对VB程序语言设计的初学者，可能会感到掌握控件的使用不难，难得的是理解和掌握算法。但是，算法是程序的核心、编程的基础，离开算法，一事无成。我们将介绍常用的VB算法。

一、常见数学问题算法

1、累加和连乘

累加是在原有和的基础上在循环体中每次加上一个数，最后根据条件结束累加，最终得到累加和。 连乘是在原有积得基础上在循环体中每次乘以一个数，最后根据条件结束连乘，最终得到连乘积。 此类问题都要结合循环结构实现，根据问题确定循环变量的初值、终值或结束条件。

【注意】① 累加和变量、连乘积变量必须在循环外赋初值。一般累加和初值为0、连乘积初值为1。 ② 对于多重循环，赋初值在外循环体外还是在内循环体外根据实际问题决定。

【计算π的近似值】用公式：

Λ+-+-≈7

1

513114π

计算，直到最后一项的绝对值小于10^-6 为止。

Private Sub Form_Click( )

Dim s As Integer, n As Single, t As Single, pi As Single t = 1 '第一项 pi = 0 '累加和初始值为0 n = 1 '每一项的分母值 s = 1 '第一项符号 Do While (Abs(t) >= 0.000001)

pi = pi + t '将每一项求和，得到π/4的近似值 n = n + 2 '产生每一项的分母值 s = -s '产生每一项的符号值 t = s / n '产生每一项 Loop

pi = pi * 4

Print "π="; pi End Sub

【斐不拉齐数列】输出斐不拉齐数列（Fibonacci ）的前40个项：1、1、2、3、5、8、13、……

数列中的第1、2项为1，其后每项都等于其前两项之和，其递推公式：()

()()

???

??≥+=====--321

112111n F

F F n F n F n n n

Private Sub Form_Click( )

Dim f1 As Long, f2 As Long, i As Integer f1 = 1 '数列第一项 f2 = 1 '数列第二项 Print f1, f2, '打印数列前两项

For i = 3 To 40 '循环输出第3至40项 f3 = f1 + f2 '计算下一个数列项 Print f3, '打印输出下一个数列项 f1 = f2 '为下一个数列项计算做准备 f2 = f3 '为下一个数列项计算做准备

If i Mod 5 = 0 Then Print '当每行输出5个以后换行 Next i End Sub

【计算e 的近似值】求自然对数e 的近似值，要求其误差小于0.00001，近似公式为：

∑∑=∞=+≈+=++++++=n

i i i i n e 00!

11!11!1!31!21!111ΛΛ

Private Sub Form_Click( )

Dim i%, n&, t!, e!

e = 0 '存放累加和

i = 0 '循环控制变量

n = 1 '存放连乘积

t = 1 '级数第i项初始值

Do While t > 0.00001

e = e + t '将每一项加入累加和

i = i + 1 '产生阶乘下一个乘数

n = n * i '乘以乘数i得到每一项的阶乘

t = 1 / n '产生每一项

Loop

Print "计算了"; i; "项的和是"; e

End Sub

【计数统计】用随机函数产生100个[0，99]范围内的随机整数，统计个位上的数字分别为1，2，3，4，5，6，7，8，9，0的数的个数并打印出来。

使用数组来处理，用数组a(1 to 100)存放产生的确100个随机整数，数组x(1 to 10)来存放个位上的数字分别为1，2，3，4，5，6，7，8，9，0的数的个数。即个位是1的个数存放在x(1)中，个位是2的个数存放在x(2)中，……个位是0的个数存放在x(10)。

Private Sub Form_Click( )

Dim a(1 To 100) , x(1 To 10) As Integer

Dim i, p As Integer

For i = 1 To 100 '产生100个[0，99]范围内的随机整数，每行10个打印出来a(i) = Int(Rnd * 100)

If a(i) < 10 Then

Print Space(2); a(i);

Else

Print Space(1); a(i);

End If

If i Mod 10 = 0 Then Print

Next i

'统计个位上的数字分别为1，2，3，4，5，6，7，8，9，0的数的个数，并将统计结果保存在数组

x(1),x(2),...,x(10)中，将统计结果打印出来

For i = 1 To 100

p = a(i) Mod 10 '求个位上的数字

If p = 0 Then p = 10 '统计数字的个数

x(p) = x(p) + 1

Next i

Print "统计结果"

For i = 1 To 10 '打印计数统计的结果

p = i

If i = 10 Then p = 0

Print "个位数为" + Str(p) + "共" + Str(x(i)) + "个"

Next i

End Sub

#######################################################################################

2、最大公约数（最小公倍数）

求两个正整数X和Y的最大公约数，可以使用递推算法，辗转相除得到。用M表示被除数，N表示除数（M>N），R表示余数。

①输入两个正整数M和N，且M>N；②计算M除以N得余数R；③如果R不为0时，使M=N 和N=R后转移到第2步再次计算；④如果R=0时，N就是所求的最大公约数。

最小公倍数就是两个数的乘积再除以最大公约数的结果。

Private Sub Command1_Click( )

Dim x, y, m, n, r As Integer

x = Val(Text1.Text) : y = Val(Text2.Text) '从文本框中输入连个正整数 If x > y Then '使得M>N ，即将两个正整数排序 m = x : n = y Else m = y : n = x End If Do '求最大公约数 r = m Mod n m = n : n = r

Loop While r <> 0

'求最小公倍数并分行打印出两个结果

Label3.Caption = "最大公约数为：" & m & vbCrLf & "最小公倍数为：" & x * y / m End Sub

【说明】① x 和y 保存了两个正整数的原值，以便最后计算最小公倍数；② If 语句保证了m>n ，但省略If 语句也不会出错，因为r = m Mod n ：m = n : n = r 会自动将较大的数交换到m 中。

###############################################################################

3、穷举法解方程

将可能出现的各种情况一一测试，判断是否满足条件，一般采用循环来实现，也称为“枚举法”。 这是一种“在没有其它办法的情况的方法”，是一种最“笨”的方法，然而对一些无法用解析法求解的问题往往能奏效，通常采用循环来处理穷举问题。

【百钱买百鸡】我国古代数学家张丘建在《算经》中曾提出一个有趣的“百钱买百鸡”问题。题意为：已知用5文钱可以买一只公鸡，3文钱可以买1只母鸡，用1文钱可以买3只小鸡，如果要用100文钱买100只鸡。请问公鸡、母鸡和小鸡应各买多少只？

（1）分析：设变量x 表示公鸡，y 表示母鸡，z 表示小鸡。则有方程组：?????

=++=++100

100

3

35z y x z y x 上述方程组中，有3个求和数，但只有两个方程，帮方程组有多个解。为解决这类问题一般需要使用

穷举法。即先对各求知数的所有可能进行穷举，然后再依次判断哪些值能满足要求。 Private Sub Form_Click( )

Dim x As Integer, y As Integer, z As Integer, num As Long For x = 0 To 100 For y = 0 To 100 For z = 0 To 100 num = num + 1

If (x + y + z = 100 And 5 * x + 3 * y + z / 3 = 100) Then Print "公鸡="; x, "母鸡="; y, "小鸡="; z End If Next z

Next y

Next x

Print "方法一的If语句测试了"; num; "次"

End Sub

（3）通过分析可知，公鸡、母鸡和小鸡的可能值为：0~20、0~33、100-x-y。

Private Sub Form_Click（）

Dim x As Integer, y As Integer, z As Integer, num As Integer

For x=0 To 20

For y=0 To 33

z=100-x-y

num=num+1

If 5*x+3*y+z/3=100 Then

Print “公鸡=”; x; “母鸡=”; y; “小鸡=”; z

End if

Next y, x

Print "方法二If语句测试"; num; "次"

End Sub

【说明】①通过num变量可以测试循环的次数，还可以使用系统变量Now测试循环使用的时间。

②在方法二中两层循环的Next相邻时，可以合而为一：Next y, x。

【注意】在多重循环中，为了提高运行的速度，要考虑对程序优化问题：

①利用已知条件，尽量减少循环的次数。

②合理地选择内、外层的循环控制变量，即将循环次数多的放在内循环。

③尽量少用变体型变量，在方法一中x、y、z使用变体型，运行的时间可由4s减少到19s。

【换零钱程序】将一张面值为100元的人民币等值换成100张5元、1元和0.5元的零钞，要求每种零钞不少于1张，问有哪几种组合？

Private Sub Form_Click( )

Dim i%, j%, k%

Print "5元", "1元", "0.5元"

For i = 1 To 20

For j = 1 To 100 - i

k = 100 - i - j

If 5 * i + 1 * j + 0.5 * k = 100 Then

Print i, j, k

End If

Next j

Next i

End Sub

##############################################################################

4、素数问题

素数（质数）就是只能被1和它本身整除的整数。

①如果整数m不能被2~m-1之间的数所整除，则m是素数。反之，如果找到一个2~ m-1之间的数能够整除m，则证明m不是素数。结合循环结构使用穷举法测试2~ m-1。

②实际上，如果整数m能被分解为两个因子a和b，那么其中较小一个因子必定小于m0.5。

③只要找到一个能整除m的数x后，已经能证明m不是素数，x的后续数据可以不再验证，可使用Exit for有条件提前退出循环。

【穷举法素数判断】输入一个正整数m，并判断m是否为素数。

Private Sub Form_Click（）

Dim m As Integer, k As Integer, i As Integer

m=Val(InputBox(“请输入一个正整数：”))

k=Sqr(m) '求m的平方根

For i=2 To k '从2到k测试是否为m的因子，如果是素数则正常退出循环

If m Mod i=0 Then Exit For '找到一个因子，不是素数则提前退出循环Next i

If i>k Then '根据结束循环的方式，打印素数判断的结果

Print m,”是素数”

Else

Print m,”不是素数”

End If

End Sub

【说明】如果程序是因为找到了一个能整除m的数，而通过Exit for语句退出For循环的，则i<=Sqr(m)；反之，如果是正常结束循环的话，则应执行i=k+1。因此，可以根据是否（i>k）来判断“是素数”或“不是素数”。

【随机产生素数】随机产生20个两位素数。

Private Sub Form_Click（）

Dim m As Integer, count As Integer, i As Integer, k As Integer

Randomize

Do Until count>=20

m=Int(Rnd*90)+10 '随机产生一个两位十进制数

k=Sqr(m) '判断该数是否素数

For i=2 To k

If m Mod i=0 Then Exit For

Next i

If i>k Then '如果是素数则打印输出到窗体上，并计数加1

Print m; ”” ;

count=count+1

If count Mod 10=0 Then Print '一行打印输出10个

End If

Loop

End Sub

【说明】①首先通过随机函数产生一个两位整数，然后再判断该整数是否是素数。如果是素数，则素数计数器count加1；如果不是素数，则产生下一个随机数。程序反复执行，直到产生20个满足条件的随机素数为止。

②外循环是一个Do Until…Loop循环，内循环是一个For…Next循环。

③语句“If count Mod 10=0 Then Print”的作用，是保证每行输出10个素数。

【寻找素数】找出100以内的素数。

Private Sub Command1_Click( )

Dim i As Integer, m As Integer

Text1.ForeColor = vbRed

Text1.Text = ""

For m = 2 To 100

For i = 2 To m - 1

If m Mod i = 0 Then GoTo NotS '不是素数则停止判断，直接退出当前的两层循环Next i

Text1.Text = Text1.Text & " " & m

End Sub

上述循环体内只要能被i整除，就不可能是素数，可利用GoTo语句退出循环。但程序中尽量少用或不用GoTo语句，通过设计一个标志变量Flag，在循环体内用Flag记录素数的判断结果，在循环结束后再根据Flag显示判断结果。

Private Sub Command2_Click( )

Dim i As Integer, m As Integer, Flag As Boolean

Text1.ForeColor = vbBlue

Text1.Text = ""

For m = 2 To 100

Flag = True '假设待判断的m为素数，将标志变量修改为True

For i = 2 To m - 1

If m Mod i= 0 Then Flag = False '不是素数，则将素数标志变量修改为False Next i

If Flag Then Text1.Text = Text1.Text & " " & m

Next m

End Sub

#################################################################

5、最大值和最小值

在若干个数中求最大值，一般先假设一个较小的数为最大值的初值，若无法估计较小的值，则取第一个数为最大值的初值，然后将每一个数与最大值比较，若该数大于最大值，将该数替换为最大值，依次逐一比较。

【最短残料】有一根长度为321m的钢材料，要将它截取成两种规格的短料，规格a、b的长度分别为17m和27m，每种至少1段，分隔成a、b各多少段后，剩余的残料r最少？

该题利用二重循环求残料r的最小值正数，因为残料不可能为负。

Private Sub Form_Click( )

Dim a%, b%, r!, ia%, ib%, t!

r = 321 '最小值初值取钢材料的长度

For b = 1 To Int((321 - 17) / 27) 'b最多的段数

For a = 1 To Int((321 - b * 27) / 17) 'a最多的段数

t = 321 - b * 27 - a * 17 '当前的残料

If t >= 0 And t < r Then '当前的残料>=零并且比最短的残料小

r = t '求最短的残料

ia = a '最短残料时a的段数

ib = b '最短残料时b的段数

End If

Next b

Print "最短残料时a的段数："; ia

Print "最短残料时b的段数："; ib

Print "最短残料为："; r

End Sub

【寻找最大值和最小值】从10个范围[1, 100]随机数中找出其最大值和最小值。

Private Sub Form_Click( )

Dim a(1 To 10) As Integer, i As Integer

Dim min, max As Integer, minindex As Integer, maxindex As Integer

For i = 1 To 10

a(i) = Int(Rnd * 100) + 1

Print a(i);

Next i

Print

min = a(1) : max = a(1) : minindex = 1 : maxindex = 1

For i = 2 To 10

If a(i) < min Then min = a(i) : minindex = i

If a(i) > max Then max = a(i) : maxindex = i

Next i

Print "第" & minindex & "个数最小：" & min

Print "第" & maxindex & "个数最大：" & max

End Sub

###################################################################################

6、递推（迭代）

“递推法”也称为“跌代法”，把一个复杂的计算过程转化为“简单过程的多次重复”。每次重复都从旧值的基础上“递推”出新值，并由“新值代替旧值”进行下一次递推。

算法思想：对于一个问题的求解x，可由给定的一个初值x0，根据某一迭代公式得到一个新的值x1，这个新值x1比初值x0更接近要求的值x；再以新值作为初值，即：x1→x0，重新按原来的方法求x1，重复这一过和直到|x1-x0|<ε（某一给定的精度）。此时可将x1作为问题的解。

【猴子吃桃的递推】小猴子在一天摘了若干个桃子，当天吃掉一半多一个；第二天接着吃了剩下的桃子的一半多一个；以后每天都吃尚存桃子的一半零一个，到第7天早上要吃时只剩下一个了，问小猴子那天共摘下了多少个桃子？

这是一个典型的“递推”问题，先从最后一天推出倒数第二天的桃子，再从倒数第二天的桃子推出倒数第三天的桃子······。设第n天的桃子为X n，那么它是前一天的桃子数X n—1的二分之一减一。即：X n=0.5 X n—1—1，也就是：X n—1=（X n+1）×2

Private Sub Form_Click( )

Dim n%, i%, x%

x = 1 '第7天的桃子

Print "第7天的桃子数为：1只"

For i = 6 To 1 Step -1

x = (x + 1) * 2

Print "第"; i; "天的桃子数为："; x; "只"

Next i

End Sub

【迭代法求平方根】已知求平方根的迭代公式为：)(210

01x a

x x +=

，用迭代法求某个数的平方根。 Private Sub Form_Click( )

Dim x As Single

x = Val(InputBox("输入一个大于0的正数：", "求平方根", 0)) If x > 0 Then

Print x & "的平方根为："; Fsqrt(x) ElseIf x = 0 Then

Print "0的平方根为0！" Else

Print "此数不能求平方根！" End If End Sub

Private Function Fsqrt( a As single ) AS single

Dim x0 As Single, x1 As Single x0 =a/2 '迭代初值 x1 = 0.5*(x0 + a/x0) Do

x0 = x1 '为下一次迭代作准备 x1 = 0.5*(x0 + a/x0)

Loop While Abs(x1 - x0) > 0.00001 Fsqrt=x1 End Function

###############################################################################

7、二分法解高次方程

假设方程f(x)=0在区间(a, b)内有唯一的根x ，则f(a)与f(b)的符号必然相反。二分法利用这个性质进过若干次迭代缩小根所在的区间，得到一个在一定误差范围内的近似根。

（a ）方程的根在中点左侧 （b ）方程的根在中点右侧

二分法求根示意图

① 取(a, b)的中点x 0=(a+b)/2，将求根区间分成两半，开始缩小根的区间。

② 如果f(x 0)与f(a)同号，则根的真值x 在中点x 0的右侧，如图（b ）所示。这时根的取值区间缩小为(x 0 ,b)，即用x 0取代a 的位置。如果f(x 0)与f(a)异号，则根的真值x 在中点x 0的左侧，如图（a ）所示。这时根的取值区间缩小为(a, x 0) ，即用x 0取代b 的位置。

③ 根据新的区间范围重复“取中点判断”，直到f(x 0)=0或区间长度b -a<ε，则x 0即为方程f(x)=0的近似根，误差小于ε。

【二分法求解方程】求方程x 3+4x 2-10=0在区间(1,4)内的实数根。要求精确到小数点后第4位。

Private Sub Form_Click( ) Dim a, b, x As Double a = 1 : b = 4 While b - a > 0.00001 x = (a + b) / 2 '求出根所在区间的中间点x f1 = a ^ 3 + 4 * a ^ 2 – 10 '求左边界点a 的方程值 f = x ^ 3 + 4 * x ^ 2 – 10 '求中间点x 的方程值 If f1 * f > 0 Then a = x Else b = x '根据两个方程值的符号异同，缩小根的区间范围 End If Wend

Print "x="; CInt(x * 10000) / 10000 End Sub

############################################################## 8、牛顿切线法解高次方程 给方程f(x)假定一个初值x 0作为方程的近似根，牛顿切线法迭代公式为：()()

i i i i x f x f x x /

1-

=+，()i x f /

是()i x f 的导数，经过若干次迭代后，当ε≤-+i i x x 1时，1+i x 就作为方程的高精度近似根。

由图可知，牛顿切线法的实质是逐步以切线与x 轴的交点来作为曲线与x 轴交点的近似值。 【牛顿切线法解高次方程】求方程f(x)=3x 3-4x 2-5x +13=0的根。 Private Sub Form_Click( )

Dim x, x0, f, f1 As Double x0 = 3 '假设一个初始近似根 Do

f = 3 * x0 ^ 3 - 4 * x0 ^ 2 - 5 * x0 + 13 '求近似根的方程值 f1 = 9 * x0 ^ 2 - 8 * x0 – 5 '求近似根的导数方程值 x = x0 - f / f1 '根据牛顿切线公式计算新的近似根x If Abs(x - x0) < 0.00001 Then Exit Do '新的近似根x 是否满足精度要求 x0 = x Loop

Print "x="; Int(x * 1000000) / 1000000 End Sub

##################################################################################### 9、数组与矩阵运算 矩阵元素可以存放在二维数组中，对矩阵的各种运算也就变成了对数组的运算。 【矩阵转置】对于n ×n 的矩阵，转置实质上是：每个元素与下标交换后对应的元素交换数据，其中两条对角线上的元素和自身交换数据。

例如，有二维数组a(5,5)，要对它实现转置，有两种方法可以实现。

Option Base 1

Private Sub Command1_Click( )

Dim a(5, 5) As Integer, i%, j%

Picture1.Cls : Picture2.Cls

For i = 1 To 5 '矩阵a赋初始值并显示在Picture1中For j = 1 To 5

a(i, j) = Int(Rnd * 9 + 1)

Picture1.Print a(i, j);

Next j

Picture1.Print

Next i

For i = 1 To 4 '将矩阵a转置

For j = i + 1 To 5

temp = a(i, j) : a(i, j) = a(j, i) : a(j, i) = temp Next j

Next i

For i = 1 To 5 '转置结果显示在Picture2中

For j = 1 To 5

Picture2.Print a(i, j);

Next j

Picture2.Print

Next i

End Sub

Private Sub Command2_Click( )

Dim a(5, 5) As Integer, i%, j%

Picture1.Cls : Picture2.Cls

For i = 1 To 5 '矩阵a赋初始值并显示在Picture1中For j = 1 To 5

a(i, j) = Int(Rnd * 9 + 1)

Picture1.Print a(i, j);

Next j

Picture1.Print

Next i

For i = 2 To 5 '将矩阵a转置

For j = 1 To i - 1

temp = a(i, j) : a(i, j) = a(j, i) : a(j, i) = temp Next j

Next i

For i = 1 To 5 '转置结果显示在Picture2中

For j = 1 To 5

Picture2.Print a(i, j);

Next j

Picture2.Print

Next i

End Sub

【矩阵乘以常数】存在2行4列矩阵nx1，对矩阵各元素乘以常数n，把结果存入矩阵nx2中。Option Base 1

Private Sub Form_Click( )

Dim nx1(2, 4) As Integer, nx2(2, 4) As Integer, x As Integer

Print "nx1数组为："

For i = 1 To 2

For j = 1 To 4

nx1(i, j) = Val(InputBox("请输入nx1数组元素："))

Print nx1(i, j); Space(8 - Len(Str(nx1(i, j))));

Next j

Print

Next i

x = Val(InputBox("输入相乘的常数："))

Print "乘以常数："; x

For i = 1 To 2

For j = 1 To 4

nx2(i, j) = x * nx1(i, j)

Next j

Next i

Print "输出nx2数组："

For i = 1 To 2

For j = 1 To 4

Print nx2(i, j); Space(8 - Len(Str(nx2(i, j))));

Next j

Print

Next i

End Sub

【矩阵相加减】假设行、列相同的两个矩阵nx1和nx2，两个矩阵相加（减），即将两个矩阵中相对应得两个元素直接相加（减），结果存放在另一矩阵中。

Option Base 1

Private Sub Form_Click( )

Dim nx1(2, 3) As Integer, nx2(2, 3) As Integer, nx3(2, 3) As Integer

Print "相加的第一个数组nx1："

For i = 1 To 2

For j = 1 To 3

nx1(i, j) = Val(InputBox("输入nx1数组："))

Print nx1(i, j); Space(8 - Len(Str(nx1(i, j))));

Next i

Print "相加的第二个数组nx2："

For i = 1 To 2

For j = 1 To 3

nx2(i, j) = Val(InputBox("输入nx2数组："))

Print nx2(i, j); Space(8 - Len(Str(nx2(i, j))));

Next j

Print

Next i

For i = 1 To 2

For j = 1 To 3

nx3(i, j) = nx1(i, j) + nx2(i, j)

Next j

Next i

Print "结果为第三个数组nx3："

For i = 1 To 2

For j = 1 To 3

Print nx3(i, j); Space(8 - Len(Str(nx3(i, j))));

Next j

Print

Next i

End Sub

【矩阵相乘除】两个矩阵nx1和nx2相乘（除）的必要条件：nx1矩阵的列数必须等于nx2矩阵的行数。结果存放在矩阵nx3(nx1行数，nx2列数) 中。根据矩阵乘法定义，nx3矩阵中各元素的值为：

()∑

=?

=

n

k

j

k

k

i

nx nx

j

i

nx

1

, ,

2 1

,

3（n为nx1的列数或nx2的行数）

Option Base 1

Private Sub Form_Click( )

Dim nx1(4, 2) As Integer, nx2(2, 3) As Integer, nx3(4, 3) As Integer Print "第一个数组nx1为："

For i = 1 To 4

For j = 1 To 2

nx1(i, j) = Val(InputBox("输入第一个数组nx1："))

Print nx1(i, j); Space(10 - Len(Str(nx1(i, j))));

Next j

Print

Next i

Print "第二个数组nx2为："

For i = 1 To 2

For j = 1 To 3

nx2(i, j) = Val(InputBox("输入第二个数组nx2："))

Print nx2(i, j); Space(10 - Len(Str(nx2(i, j))));

Next j

Print "结果的第三个数组nx3为："

For i = 1 To 4

For j = 1 To 3

nx3(i, j) = 0

For k = 1 To 2

nx3(i, j) = nx3(i, j) + nx1(i, k) * nx2(k, j)

Next k

Print nx3(i, j); Space(10 - Len(Str(nx3(i, j))));

Next j

Print

Next i

End Sub

#####################################################################################

10、验证哥德巴赫猜想

哥德巴赫猜想：任意一个大于等于6的偶数都可以分解为两个素数之和。

基本思想：n为大于等于6的任一偶数，可分解为n1和n2两个数，分别检查n1和n2是否为素数，如都是，则为一组解。如n1不是素数，就不必再检查n2是否素数。先从n1=3开始，检验n1和n2（n2=N-n1）是否素数。然后使n1+2 再检验n1、n2是否素数，……直到n1=n/2为止。

Private Function Prime(m As Integer) As Boolean '判断素数函数

Dim i%

Prime = True

For i = 2 To Int(Sqr(m))

If m Mod i = 0 Then Prime = False : Exit For

Next i

End Function

Private Sub Command1_Click( )

Dim num%, num1%, num2%

num = 6 : num1 = 2

aa: num1 = num1 + 1 '分解一个偶数出第一个加数

num2 = num - num1 '分解一个偶数出第二个加数

If Prime(num1) = False Then GoTo aa '判断第一个加数是否素数

'如果第二个加数也是素数，则添加到list1中

If Prime(num2) = False Then

GoTo aa

Else

List1.AddItem num & "=" & num1 & "+" & num2

End If

num = num + 2 '准备判断下一个偶数

If num <= 100 Then num1 = 2 : GoTo aa

End Sub

Private Sub Command2_Click( )

Dim num%, num1%, num2%

For num = 6 To 100 Step 2

For num1 = 3 To num \ 2 Step 2

num2 = num - num1

If Prime(num1) Then

If Prime(num2) Then

List1.AddItem num & "=" & num1 & "+" & num2 ：Exit For

End If

End If

Next num1

Next num

End Sub

二、字符处理算法

【字母图形程序】当单击“生成图形”按钮后，按用户指定的“首字母”和“行数”，生成如图所示的由大写字母构成的图形。

Private Sub Command1_Click( )

Dim ch As String, ln As Integer, temp As Integer

Dim i, j, n As Integer

Picture1.Cls

ch = UCase(Text1.Text) '取得首字母

ln = Val(Text2.Text) '取得行数

n = Asc(ch) - Asc("A") '求与A的距离

For i = 1 To ln

Picture1.Print Tab(12 - i); '输出每行空格距离

For j = 1 To 2 * i – 1 '打印每行的其他字母字符

temp = Asc("A") + n '计算下一个将要打印的字符

If (temp > Asc("Z")) Then '判断是否超出英文字母范围

n = 0 ：temp = Asc("A") '如果超出范围，则回到A字母位置

End If

Picture1.Print Chr(temp); '打印出一个英文字母字符

n = n + 1

Next j

Picture1.Print

Next i

End Sub

【字符分类统计】单击“统计”按钮后，统计文本框Text1中各种字母（不区分大小写）出现的次数，将统计的结果存放在数组intCount中，并将出现次数大于1的字母及其出现次数显示在picture1中。要求按每行6个的格式输出。

Option Base 1

Private Sub Command1_Click( )

Dim intCount(26) As Integer

Dim str$, n%, ch As String * 1

Dim i%, j%, num%

Picture1.Cls

Text1.Text = "This is a Visual Basic Program!"

str = Text1.Text ：n = Len(str)

For i = 1 To n '统计计数

ch = UCase(Mid(str, i, 1)) '取得字符串中的一个字符

If (ch >= "A" And ch <= "Z") Then '判断并分类统计字母个数

j = Asc(ch) - Asc("A") + 1 : intCount(j) = intCount(j) + 1

End If

Next i

For j = 1 To 26 '打印统计的结果

If intCount(j) > 0 Then

Picture1.Print Chr$(j + 64); "="; intCount(j);

num = num + 1

If num Mod 6 = 0 Then Picture1.Print '每行打印六个统计结果

End If

Next j

End Sub

【统计文本单词个数】从字符串的左边开始，取出每一个字符，判断是否是英文字母字符。如果一个字符是英文字母字符，同时前一个字符是非英文字母字符时，说明该英文字母字符是一个新单词的第一个字母，单词数量增加一个。如果一个非英文字母字符或连续两个英文字母表示没有新单词出现。

Private Sub Command1_Click( )

Dim Nw, nL As Integer, Wt As Boolean, strIN, strT As String

Nw = 0 '整数变量Nw保存单词个数

Wt = False '逻辑变量Wt保存是否英文字符

strIN = Text1.Text '从Text1.Text中读取英文字符串

nL = Len(RTrim(strIN))

For i = 1 To nL '依次判断每一个字符是否英文字母

strT = Mid$(strIN, i, 1) '取第i个字符保存到字符串变量strT中

If (strT > "A" And strT < "Z") Or (strT > "a" And strT < "z") Then

If Not Wt Then '如果前一个字母不是英文字母，则找到一个新单词

Nw = Nw + 1 '单词计数变量Nw加1

Wt = True '这个字符是英文字母

End If

Else

Wt = False '这个字符非英文字母

End If

Next i

Label1.Caption = "单词数为：" & Str(Nw) '显示单词个数

End Sub

【英文打字练习】编写一个英文打字训练的程序。要求：①在标签框内随机产生30个字母的范文；

②当焦点进入文本框时开始计时，并显示当时的时间；③在文本框按产生的范文输入相应的字母；④当计时时间结束后，禁止向文本框输入内容，显示打字的速度和正确率。

Dim t As Date

Private Sub Command1_Click( ) '产生30个字母的范文

Randomize : Label5 = ""

For i = 1 To 30

a = Chr$(Int(Rnd * 26) + 65)

Label5 = Label5 & a

Next i

End Sub

Private Sub Text1_GotFocus( )

t = Time '输入文本框获得焦点，开始计时

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)

Dim t2 As Date

If Len(Text1) = 30 Then '输入满30个字符

t2 = Time - t '计算时间

Label3.Caption = "时间(s)：" & t2 '显示时间

Text1.Locked = True '不允许再修改

y = 0 : n = 0

For i = 1 To 30 '计算正确率

If UCase(Mid(Text1, i, 1)) = UCase(Mid(Label5.Caption, i, 1)) Then

y = y + 1

Else

n = n + 1

End If

Next i

y = y / (y + n) * 100

Label4.Caption = "准确率(%)：" & Str(y)

End If

End Sub

Private Sub Command2_Click( ) '结束计算时间和正确率

Call Text1_KeyPress(0)

End Sub

【文本的加密解密】基本思想是：将文本的每个字符采用“统一规律”转换为其他字符，同时必须存在一个逆向转换过程进行解密。

最简单的字母加密方法是：将每个字母加（或减）一个序数K，变换式公式：c=chr(Asc(c)+k)。

例如，加序数5，这时“A”→“F”，“a”→“f”，“B”→“G”，“Z”→“E”。

解密为加密的逆过程：将每个字母减（或加）加密时的序数K，变换式公式：c=chr(Asc(c)-k)。

例如，序数K为5，这时“Z”→“U”，“z”→“u”，“Y”→“T”。

当减序数后的字母小于“A”或“a”，则c=Chr(Asc(c)-k +26)

当加序数后的字母大于“Z”或“z”，则c=Chr(Asc(c)+k-26)

例如，将文本框1中的字母加密，将文本框2中的字母解密。

Private Sub Command1_Click( )

Dim strIN, strS, strT, strP As String, keycode, nl, i As Integer

Label1.Visible = False : Label2.Visible = True

i = 1 : strP = ""

strIN = Text1.Text '获取整个文本

keycode = Val(Text3.Text) '获取加密值

nl = Len(RTrim(strIN)) '测试整个文本长度

Do While (i <= nl) '逐个判断并加密每个字母

strT = Mid$(strIN, i, 1) '取出第i个字符

If (strT >= "A" And strT <= "Z") Then '对大写字母加密

strS = Asc(strT) + keycode

If strS > Asc("Z") Then strS = strS - 26

strP = strP + Chr$(strS)

ElseIf (strT >= "a" And strT <= "z") Then '对小写字母加密

strS = Asc(strT) + keycode

If strS > Asc("z") Then strS = strS - 26

strP = strP + Chr$(strS)

Else

strP = strP + strT '非英文字母不加密

End If

i = i + 1

Loop

Text2.Text = strP '在Text2输出加密文本

End Sub

Private Sub Command2_Click( )

Dim strIN, strS, strT, strP As String, keycode, nl, i As Integer

Label2.Visible = False : Label1.Visible = True

i = 1 : strP = ""

strIN = Text2.Text '获取整个文本

keycode = Val(Text3.Text) '获取解密值

nl = Len(RTrim(strIN)) '测试整个文本长度

Do While (i <= nl) '逐个判断并解密每个字母

strT = Mid$(strIN, i, 1) '取出第i个字符

If (strT >= "A" And strT <= "Z") Then '对大写字母解密

strS = Asc(strT) - keycode

If strS < Asc("A") Then strS = strS + 26

strP = strP + Chr$(strS)

ElseIf (strT >= "a" And strT <= "z") Then '对小写字母解密

strS = Asc(strT) - keycode

If strS < Asc("a") Then strS = strS + 26

strP = strP + Chr$(strS)

Else

strP = strP + strT '非英文字母不解密

End If

i = i + 1

Loop

Text1.Text = strP '在Text1输出解密文本

End Sub

三、数据处理算法

1、数制转换

【进制转换】任意输入一个十进制整数，单击“转换”按钮后，将该数转换为指定R（2－16）进制的数值字符串。

思路：将m不断除r取余数，直到商为零，以反序得到结果。下面写出一转换函数，参数idec为十进制数，ibase为要转换成数的基（如二进制的基是2，八进制的基是8等），函数输出结果是字符串。

Private Sub Command1_Click( )

Dim num%, base%, r%

num = Val(Text1.Text) '输入十进制正整数

base = Val(Text2.Text) '输入r进制

If base > 2 And base < 16 Then '判断进制是否合理

Text3.Text = DecTran(num, base) '调用转换函数显示转换结果

Else

MsgBox "输入的进制超出范围" ：Text2.Text = "" ：Text2.SetFocus

End Sub

Private Function DecTran(idec%, ibase%) As String

Dim strDecR$, iDecR%

strDecR = "0"

Do While idec <> 0 '不断出某进制数ibase取余数直到商为0

iDecR = idec Mod ibase

If iDecR >= 10 Then '余数>=0转换为A--F

strDecR = Chr$(65 + iDecR - 10) & strDecR

Else '余数<0直接转换

strDecR = iDecR & strDecR

End If

idec = idec \ ibase

Loop

DecTran = strDecR

End Function

【使用说明】将需要转换的数据存入num，将需要转换的进制存入base，调用DecTran（num，base）后即可得到转换结果。

############################################################################

2、查找

【顺序查找程序】是最简单、最直接查找算法，其思想为：从第一个数据开始逐一与查找对象比较，直到找到（或未找到）指定的数据。

Private Sub Form_Click( )

Dim a%( ),i%, objNum%, num%, n%, flag As Boolean

Randomize : Cls

Do

n = Val(InputBox("确定数据个数n："))

Loop Until n = Int(n) And n > 0

Print "在下列" & n & "个数中查找数据："

ReDim a(n)

For i = 1 To n '通过随机函数，初始化原始数据

a(i) = Int(Rnd * 99) + 1

Print a(i); Tab(5 * (i Mod 10));

If i Mod 10 = 0 Then Print

Next i

Print

objNum = Val(InputBox("请输入要查找的数："))

flag = False : num = 0 '设置查找标志

For i = 1 To n

If objNum = a(i) Then '如果找到制定数据，则退出

flag = True ：num = i ：Exit For

End If

Next i

If flag = True Then