VB常见20道编程代码.doc

学习资料收集于网络，仅供参考哈哈哈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 nEnd SubPrivate Sub Command2_Click() EndEnd Sub2.百元买百鸡Private Sub Command1_Click()Dim i As IntegerDim j As IntegerFor 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 jNext iEnd SubPrivate Sub Command2_Click() EndEnd Sub3. 不靠边元素和Private Sub Command1_Click()ClsRandomizeDim 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 PrintNext ik = SumSum = 0For i = 0 To 5Sum = Sum + a(i, 0) + a(i, 5) + a(0, i) + a(5, i)Next iSum = Sum - a(0, 0) - a(5, 0) - a(5, 5) - a(0, 5)Text1 = k - SumEnd SubPrivate Sub Command2_Click() EndEnd Sub4.递归函数求斐波拉契数列Option ExplicitPrivate 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 iEnd SubPrivate Sub Command2_Click() EndEnd Sub5.各位数之和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 = sEnd SubPrivate Sub Command2_Click() EndEnd Sub6.回文数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 IfEnd SubPrivate Sub Command2_Click() Text1 = Text2 = End SubPrivate Sub Command3_Click() EndEnd Sub7.级数求和Private Sub Command1_Click() Dim i As Integer, t As Long, s As Singlei = 0: s = o: t = 1Dos = s + 1 / ti = i + 1t = t * iLoop Until 1 / t 0.000001Text1 = sEnd SubPrivate Sub Command2_Click() EndEnd Sub8.矩阵的转置Option ExplicitOption Base 1Dim i As IntegerDim j As IntegerDim a() As IntegerDim n As IntegerPrivate Sub Command1_Click()Text3.SetFocusn = 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 iEnd SubPrivate Sub Command2_Click()Dim b() As Integern = 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 iEnd SubPrivate Sub Command3_Click()Text1 = Text2 = Text3 = 清除Text3.SetFocusEnd SubPrivate Sub Command4_Click()End 结束End SubPrivate Sub Form_Load()Text1 = Text2 = Text3 = 清除End Sub9.靠边元素和Private Sub Command1_Click()ClsRandomizeDim a(5, 5) As IntegerFor 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 PrintNext iSum = 0For i = 0 To 5Sum = Sum + a(i, 0) + a(i, 5) + a(0, i) + a(5, i)NextSum = Sum - a(0, 0) - a(5, 0) - a(5, 5) - a(0, 5)Text1 = SumEnd SubPrivate Sub Command2_Click() EndEnd Sub10.冒泡排序Option ExplicitOption Base 1Dim a(10) As IntegerDim i As IntegerPrivate 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 iEnd SubPrivate Sub Command2_Click()Dim j As IntegerDim t As IntegerFor 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 jNext iFor i = 1 To 10 Text2 = Text2 & Str(a(i) & If i Mod 5 = 0 Then Text2 = Text2 & Chr(13) & Chr(10)Next iEnd SubPrivate Sub Command3_Click()Text1 = Text2 = End SubPrivate Sub Command4_Click()EndEnd Sub11.逆序数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 = sEnd SubPrivate Sub Command2_Click() EndEnd Sub12.判断素数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 IfEnd SubPrivate Sub Command2_Click() Text1 = End SubPrivate Sub Command3_Click() EndEnd Sub13.求阶乘（递归）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 IfEnd FunctionPrivate Sub Command1_Click() Dim n As Long n = Val(Text1) Text2 = f(n)End SubPrivate Sub Command2_Click() Text1 = Text2 = End SubPrivate Sub Command3_Click() EndEnd Sub14.求质因子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 iEnd SubPrivate Sub Command2_Click() Text1 = Picture1.ClsEnd SubPrivate Sub Command3_Click() EndEnd Sub15.水仙花数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 SubPrivate Sub Command2_Click() EndEnd Sub16.顺序查找Option ExplicitOption Base 1Dim a(10) As IntegerDim i As IntegerPrivate 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 iEnd SubPrivate Sub Command2_Click()Dim x As Integerx = Val(Text2)For i = 1 To 10 If a(i) = x Then Exit ForNext iIf i k Then k = a(i)Next iText2 = kl = a(1)For i = 2 To 10 If a(i) = a And m = z Then n = n + 1 End If Next i Text2 = nEnd SubPrivate Sub Com