[中学]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