[笔记]VB常见20道编程代码

[笔记]VB常见20道编程代码 20道编程代码 1.1000以内的所有完数 Private Sub Command1_Click() Dim n As Integer Dim i As Integer Dim s As Long For n = 1 To 1000 s = 1 For i = 2 To n - 1 If n Mod i = 0 Then s = s + i Next i If s = n Then Text1 = Text1 & n & " " If k Mod 5 = 0 Then Text1 = Text1 & vbCrLf End If Next n End Sub Private Sub Command2_Click() End End Sub 2.百元买百鸡 Private Sub Command1_Click() Dim i As Integer Dim j As Integer For i = 0 To 20 For j = 0 To 33 If 5 * i + 3 * j + (100 - i - j) * 1 / 3 = 100 Then Text1 = Text1 & "买" & CStr(i) & "只公鸡" & CStr(j) & "只母鸡" & CStr(100 - i - j) & "只小鸡" Text1 = Text1 & Chr(13) & Chr(10) End If Next j Next i End Sub Private Sub Command2_Click() End End Sub 3.不靠边元素和 Private Sub Command1_Click() Cls Randomize Dim a(5, 5) As Integer, s% For i = 0 To 5 For j = 0 To 5 a(i, j) = Int(Rnd * 9) Print a(i, j) & ","; Sum = Sum + a(i, j) Next j Print Next i k = Sum Sum = 0 For i = 0 To 5 Sum = Sum + a(i, 0) + a(i, 5) + a(0, i) + a(5, i) Next i Sum = Sum - a(0, 0) - a(5, 0) - a(5, 5) - a(0, 5) Text1 = k - Sum End Sub Private Sub Command2_Click() End End Sub 4.递归函数求斐波拉契数列 Option Explicit Private Sub Command1_Click() Dim a1, a2, b As Integer Dim i, n As Integer n = InputBox("显示数列的前N项") a1 = 1 For i = 1 To n b = a1 + a2 Text1.SelText = b & " " a1 = a2 a2 = b Next i End Sub Private Sub Command2_Click() End End Sub 5.各位数之和 Private Sub Command1_Click() Dim i As String Dim j% Dim s% i = Text1 For j = 1 To Len(i) st = Mid(i, j, 1) s = s + Val(st) Next j Text2 = s End Sub Private Sub Command2_Click() End End Sub 6.回文数 Private Sub Command1_Click() Dim x$, y$, c$, i% x = Text1 For i = 1 To Len(x) c = Mid(x, i, 1) y = c + y Next i If y = x Then Text2 = "x是回文数" Else Text2 = "x不是回文数" End If End Sub Private Sub Command2_Click() Text1 = "" Text2 = "" End Sub Private Sub Command3_Click() End End Sub 7.级数求和Private Sub Command1_Click() Dim i As Integer, t As Long, s As Single i = 0: s = o: t = 1 Do s = s + 1 / t i = i + 1 t = t * i Loop Until 1 / t < 0.000001 Text1 = s End Sub Private Sub Command2_Click() End End Sub 8.矩阵的转置 Option Explicit Option Base 1 Dim i As Integer Dim j As Integer Dim a() As Integer Dim n As Integer Private Sub Command1_Click() Text3.SetFocus n = Val(Text3) ReDim a(n, n) '动态数组 For i = 1 To n For j = 1 To n a(i, j) = Int(10 * Rnd + 0) '随机数 Text1 = Text1 & a(i, j) & " " '一行 Next j Text1 = Text1 & Chr(13) & Chr(10) '多行 Next i End Sub Private Sub Command2_Click() Dim b() As Integer n = Val(Text3) ReDim b(n, n) For i = 1 To n For j = 1 To n b(i, j) = a(j, i) '转置 Text2 = Text2 & b(i, j) & " " '一行 Next j Text2 = Text2 & Chr(13) & Chr(10) '多行 Next i End Sub Private Sub Command3_Click() Text1 = "" Text2 = "" Text3 = "" '清除 Text3.SetFocus End Sub Private Sub Command4_Click() End '结束 End Sub Private Sub Form_Load() Text1 = "" Text2 = "" Text3 = "" '清除 End Sub 9.靠边元素和 Private Sub Command1_Click() Cls Randomize Dim a(5, 5) As Integer For i = 0 To 5 For j = 0 To 5 a(i, j) = Int(Rnd * 9) Print a(i, j) & ","; Sum = Sum + a(i, j) Next j Print Next i Sum = 0 For i = 0 To 5 Sum = Sum + a(i, 0) + a(i, 5) + a(0, i) + a(5, i) Next Sum = Sum - a(0, 0) - a(5, 0) - a(5, 5) - a(0, 5) Text1 = Sum End Sub Private Sub Command2_Click() End End Sub 10.冒泡排序 Option Explicit Option Base 1 Dim a(10) As Integer Dim i As Integer Private Sub Command1_Click() For i = 1 To 10 a(i) = Int(90 * Rnd + 10) Text1 = Text1 & Str(a(i)) & " " If i Mod 5 = 0 Then Text1 = Text1 & Chr(13) & Chr(10) Next i End Sub Private Sub Command2_Click() Dim j As Integer Dim t As Integer For i = 1 To 9 For j = 1 To 10 - i If a(j) < a(j + 1) Then t = a(j) a(j) = a(j + 1) a(j + 1) = t End If Next j Next i For i = 1 To 10 Text2 = Text2 & Str(a(i)) & " " If i Mod 5 = 0 Then Text2 = Text2 & Chr(13) & Chr(10) Next i End Sub Private Sub Command3_Click() Text1 = "" Text2 = "" End Sub Private Sub Command4_Click() End End Sub 11.逆序数 Private Sub Command1_Click() Dim a As String Dim i% Dim s As String a = Text1 For i = 1 To Len(a) st = Mid(a, i, 1) s = st + s Next i Text2 = s End Sub Private Sub Command2_Click() End End Sub 12.判断素数 Private Sub Command1_Click() Dim n As Integer Dim i As Integer n = Val(Text1) If n = 1 Then MsgBox (CStr(n) & "是素数") Else For i = 2 To n - 1 If n Mod i = 0 Then Exit For Next i If i = n Then MsgBox (CStr(n) & "是素数") Else MsgBox (CStr(n) & "不是素数") End If End If End Sub Private Sub Command2_Click() Text1 = "" End Sub Private Sub Command3_Click() End End Sub 13.求阶乘(递归) Private Function f(ByVal n As Long) As Long Dim i As Integer f = 1 If n = 0 Or n = 1 Then f = 1 Else For i = 1 To n f = f * i Next i End If End Function Private Sub Command1_Click() Dim n As Long n = Val(Text1) Text2 = f(n) End Sub Private Sub Command2_Click() Text1 = "" Text2 = "" End Sub Private Sub Command3_Click() End End Sub 14.求质因子 Private Sub Command1_Click() Dim n%, i%, m% n = Val(Text1) For i = 1 To n If i = 1 Then Picture1.Print Else If n Mod i = 0 Then For m = 2 To i - 1 If i Mod m = 0 Then Exit For Next m If m = i Then Picture1.Print i, End If Picture1.Print End If End If Next i End Sub Private Sub Command2_Click() Text1 = "" Picture1.Cls End Sub Private Sub Command3_Click() End End Sub 15.水仙花数 Private Sub Command1_Click() Dim a, b, c As Integer For a = 0 To 9 For b = 0 To 9 For c = 1 To 9 If a ^ 3 + b ^ 3 + c ^ 3 = a + 10 * b + 100 * c Then MsgBox 100 * c + 10 * b + a End If Next c Next b Next a End Sub Private Sub Command2_Click() End End Sub 16.顺序查找 Option Explicit Option Base 1 Dim a(10) As Integer Dim i As Integer Private Sub Command1_Click() For i = 1 To 10 a(i) = Int(90 * Rnd + 10) Text1 = Text1 & Str(a(i)) If i Mod 5 = 0 Then Text1 = Text1 & Chr(13) & Chr(10) Next i End Sub Private Sub Command2_Click() Dim x As Integer x = Val(Text2) For i = 1 To 10 If a(i) = x Then Exit For Next i If i <= 10 Then Text3 = Str(x) + "在第" + Str(i) + "个位置" Else Text3 = "没有找到" End If End Sub Private Sub Command3_Click() Text1 = "" Text2 = "" Text3 = "" End Sub Private Sub Command4_Click() End End Sub 17.随机10个整数最值，均值，和 Dim i As Integer Dim a(10) As Integer Private Sub Command1_Click() Randomize For i = 1 To 10 a(i) = Int(90 * Rnd + 10) Next i For i = 1 To 10 Text1 = Text1 & a(i) & " " Next i End Sub Private Sub Command2_Click() Dim k As Integer Dim l As Integer Dim s As Integer k = a(1) For i = 2 To 10 If a(i) > k Then k = a(i) Next i Text2 = k l = a(1) For i = 2 To 10 If a(i) < l Then l = a(i) Next i Text3 = l s = 0 For i = 1 To 10 s = s + a(i) Next i Text5 = s Text4 = s / 10 End Sub Private Sub Command3_Click() End End Sub Private Sub Form_Load() End Sub 18.字符统计 Private Sub Command1_Click() Dim s As String, i%, m As String, n% s = Text1 n = 0 For i = 1 To Len(s) m = Mid(s, i, 1) If m >= "a" And m <= "z" Then n = n + 1 End If Next i Text2 = n End Sub Private Sub Command2_Click() End End Sub 19.最大公约数 Private Sub Command1_Click() Dim m As Integer Dim n As Integer Dim k As Integer m = Val(Text1) n = Val(Text2) Do k = m Mod n m = n n = k Loop Until k = 0 Text3 = CStr(m) End Sub Private Sub Command2_Click() Text1 = "" Text2 = "" Text3 = "" End Sub Private Sub Command3_Click() End End Sub 20.最小公倍数 Option Explicit Private Sub Command1_Click() Dim m%, n%, k% Dim m1%, n1% Dim s% m = Val(Text1): n = Val(Text2) m1 = m: n1 = n Do k = m Mod n m = n n = k Loop Until k = 0 s = m1 * n1 / m Text3 = s End Sub Private Sub Command2_Click() Text1 = "" Text2 = "" Text3 = "" End Sub Private Sub Command3_Click() End End Sub