Private Sub Command1_Click() List1.Clear For i = 1 To 30 List1.AddItem CInt(Rnd * (100 - 10 + 1)) + 10 Next End Sub Private Sub Command2_Click() List2.Clear For i = 0 To List1.ListCount - 1 If prime(List1.List(i)) = True Then List2.AddItem List1.List(i) End If Next End Sub Function prime(n) As Boolean For i = 2 To n - 1 If n Mod i = 0 Then Exit For Next If i > n - 1 Then prime = True Else prime = False End If End Function Private Sub Command3_Click() List3.Clear Dim t As Integer For i = 0 To List2.ListCount - 1 List3.AddItem List2.List(i) Next For i = 0 To List3.ListCount - 1 For j = 0 To List3.ListCount - 1 If CInt(List3.List(i)) > CInt(List3.List(j)) Then t = CInt(List3.List(i)) List3.List(i) = List3.List(j) List3.List(j) = CInt(t) End If Next Next End Sub
Dim a(100), b() As Integer Private Sub Command1_Click() List1.Clear For i = 1 To 100 a(i) = Int(Rnd * (99 - 10 + 1) + 10) List1.AddItem a(i) Next End Sub Private Sub Command2_Click() List2.Clear For i = 1 To UBound(a) s = 0 For j = 1 To 100 - 1 If a(i) Mod j = 0 Then s = s + 1 End If Next If s = 2 Then List2.AddItem a(i) End If Next End Sub Private Sub Command3_Click() List3.Clear l = List2.ListCount - 1 ReDim b(l) For i = 0 To l b(i) = List2.List(i) Next For i = 0 To l For j = 0 To l - 1 If b(j) > b(j + 1) Then t = b(j) b(j) = b(j + 1) b(j + 1) = t End If Next Next For i = 0 To l List3.AddItem b(i) Next End Sub
Dim a(30), b(30) Private Sub Command1_Click() List1.Clear For i = 1 To 30 a(i) = Int(Rnd * (100 - 10 + 1)) + 10 List1.AddItem a(i) Next End Sub Private Sub Command2_Click() List2.Clear s = 1 flag = 0 For i = 1 To 30 For j = 2 To a(i) - 1 If a(i) Mod j <> 0 Then flag = 1 Else flag = 0 Exit For End If Next If flag = 1 Then List2.AddItem a(i) flag = 0 b(s) = a(i) s = s + 1 End If Next End Sub Private Sub Command3_Click() List3.Clear For i = 1 To List2.ListCount - 1 Max = b(i) For j = i + 1 To List2.ListCount If b(j) < Max Then Max = b(j) t = b(i) b(i) = b(j) b(j) = t End If Next Next For i = 1 To List2.ListCount List3.AddItem b(i) Next End Sub
[/collapse]
102.顺序查找
代码
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
Private Sub Form_Click() Dim a(10) For i = 1 To 10 a(i) = Int(Rnd * (99 - 10 + 1)) + 10 Print a(i); Next find a(), 11 End Sub Function find(a(), n) Print For i = 1 To UBound(a) If n = a(i) Then key = i Exit For End If Next Print key End Function
Private Sub Form_Click() Cls find End Sub Function find() Dim a(10) As Integer For i = 1 To 10 a(i) = Int(Rnd * (99 - 10 + 1)) + 10 Print a(i); Next n = Val(InputBox("请输入要查找的数:")) For i = 1 To 10 If n = a(i) Then l = i Exit For End If Next Print Print "你找的是:" & n & " 在第" & l & "处" End Function
[/collapse]
103.输出素数
代码
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
Private Sub Command1_Click() Cls For i = 3 To 100 If prime(i) Then Print i End If Next End Sub Function prime(n) As Boolean prime = True For i = 2 To Sqr(n) If n Mod i = 0 Then prime = False Exit Function End If Next End Function
104.打印图形
代码
1 2 3 4 5 6 7 8 9
Sub Triangle(n As Integer) For i = 1 To n Print Space(n - i); For j = 1 To i * 2 - 1 Print "*"; Next Print Next End Sub
105.逆序输出字符串
(禁止使用strreverse函数)
代码
1 2 3 4 5 6
Cls s = InputBox("请输入:") Print s For i = Len(s) To 1 Step -1 Print Mid(s, i, 1); Next
106.打印成绩
代码
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
Dim a(10) As Integer For i = 1 To 10 a(i) = Int(Rnd * (100 - 60 + 1)) + 60 Print a(i); s = s + a(i) Next Max = a(1): Min = a(1) For i = 1 To 10 If a(i) > Max Then Max = a(i) End If If a(i) < Min Then Min = a(i) End If Next Print "最高分:" & Max & " 最低分:" & Min
代码
1 2 3 4 5 6 7 8 9 10 11 12 13 14
Dim a(10) As Integer For i = 1 To 10 a(i) = Int(Rnd * (100 - 60 + 1)) + 60 Print a(i); s = s + a(i) Next Print Avg = s / 10 For i = 1 To 10 If a(i) > Avg Then n = n + 1 End If Next Print "平均分是:" & Avg & " 高于平均分的人数有:" & n & "人"
Dim a(10) As Integer Print "原数组" For i = 1 To 10 a(i) = Int(Rnd * (100 - 1 + 1)) + 1 Print a(i); Next Print Print "从小到大" For i = 1 To 10 For j = i To 10 If a(i) > a(j) Then t = a(i) a(i) = a(j) a(j) = t End If Next Next For i = 1 To 10 Print a(i); Next Print Print "交换后" For i = 1 To 5 t = a(i) a(i) = a(5 + i) a(5 + i) = t Next For i = 1 To 10 Print a(i); Next
108.计算阶乘
代码
1 2 3 4 5 6 7 8 9 10 11
Dim s, sum As Double n = (Text1) s = 1 If n < 20 Then For i = 1 To n s = s * i a = s sum = sum + 1 / a Next Label1 = "Sum=" & sum End If
109.平均分
代码
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
Dim a(1 To 10) As Integer For i = 1 To 10 a(i) = Int(Rnd * (100 - 1 + 1)) + 1 s = s + a(i) Print a(i); Next Max = a(1): Min = a(1) For i = 1 To 10 If a(i) > Max Then Max = a(i) End If If a(i) < Min Then Min = a(i) End If Next Print Print "去掉一个最高分:" & Max & " 去掉一个最低分:" & Min Avg = (s - Max - Min) / 10 Print "平均分为:" & Avg
110.统计人口
代码
1 2 3 4 5 6 7 8 9 10 11
people = 1300000000 n = 1 For i = 1 To 100 people = people * 1.008 If people > 2600000000# Then Exit For Else n = n + 1 End If Next Print n & "年后我国人口超过26亿"
投机取巧法
1 2
n = Int(Log(2) / Log(1.008) + 1) Print n & "年后人数超过26亿"
111.计时器
代码
1 2 3 4 5 6 7 8 9 10 11 12
Private Sub Command1_Click() Timer1.Enabled = True End Sub Private Sub Command2_Click() Timer1.Enabled = False Text1 = "" End Sub Private Sub Timer1_Timer() ' Text1 = Date & " " & Time Text1 = Year(Now) & "-" & Month(Now) & "-" & Day(Now) & " " _ & Time End Sub
112.滚动控件
代码
1 2 3 4 5 6 7
Private Sub Form_Load() HScroll1.Max = 2500 HScroll1.Min = 100 End Sub Private Sub HScroll1_Change() Shape1.Left = HScroll1.Value End Sub
113.求最大最小值
代码
1 2 3 4 5 6 7 8 9 10 11 12 13 14
a(0) = Text1.Text a(1) = Text2.Text a(2) = Text3.Text a(3) = Text4.Text Min = a(0): Max = a(0) For i = 0 To 3 If a(i) < Min Then Min = a(i) End If If a(i) > Max Then Max = a(i) End If Next Print "最小值是:" & Min & " 最大值是:" & Max
114.计算类别
代码
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
n = Text1 If Option1 = True Then For i = 1 To n If i Mod 2 = 0 Then s = s + i End If Next Label1 = s Else For i = 1 To n If i Mod 2 <> 0 Then s = s + i End If Next Label1 = s End If
115.加密
代码
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
Text2 = "" For i = 1 To Len(Text1) res = Asc(Mid(Text1, i, 1)) Select Case res Case 65 To 89 res = res + 1 Case 97 To 121 res = res + 1 End Select If Mid(Text1, i, 1) = "z" Then res = Replace(res, 122, 97) End If If Mid(Text1, i, 1) = "Z" Then res = Replace(res, 90, 65) End If Text2 = Text2 & Chr(res) Next
116.计算折扣价
代码
1 2 3 4 5 6 7
s = Val(Text1) * Val(Text2) If s >= 2000 Then ss = s * 0.8 ElseIf s >= 1000 Then ss = s * 0.9 End If Label1 = "原 价:" & s & vbCrLf & "折扣价:" & ss
117.分段函数
代码
1 2 3 4 5 6 7 8 9
x = Val(Text1) y = Val(Text2) If x > 0 And y > 0 Then Label1 = Sqr(x + y) ElseIf x < 0 And y < 0 Then Label1 = Sqr(Abs(x - y)) Else Label1 = 0 End If
118.综合情况
?
代码
119.输出数组
代码
1 2 3 4 5 6 7 8 9 10 11 12
For i = 1 To 10 s = Int(Rnd * (999 - 100 + 1)) + 100 Print s; If s Mod 2 = 0 Then o = o & s & " " Else j = j & s & " " End If Next Print Print o Print j
120.统计数字
代码
1 2 3 4 5 6 7 8 9 10 11 12 13 14
s = Text1 For i = 1 To Len(s) res = Mid(s, i, 1) If res Like "[A-Z]" Then n = n + 1 ElseIf res Like "[a-z]" Then m = m + 1 Else mn = mn + 1 End If Next Label1 = n Label2 = m Label3 = mn
121.输出成绩
代码
1 2 3 4 5 6 7 8 9 10 11 12 13 14
Picture1.Cls Picture2.Cls For i = 1 To 20 s = Int(Rnd * (101)) If s >= 60 Then n = n + 1 End If Sum = Sum + s Picture1.Print s; If i Mod 5 = 0 Then Picture1.Print End If Next Picture2.Print "平均分:" & Sum / 20 & Chr(13) & "及格人数:" & n
122.打印题
代码
1 2 3 4 5 6 7 8
For i = 1 To 5 Print Tab(5 - i + 1); Print String(i * 2 - 1, "*"); Next For i = 4 To 1 Step -1 Print Tab(4 - i + 2); Print String(i * 2 - 1, "*"); Next
123.鸡兔同笼
代码
1 2 3 4 5 6 7 8
m = Val(Text1) n = Val(Text2) If n >= 2 * m Then rabbit = n / 2 - m chicken = m - rabbit End If Label1 = chicken Label2 = rabbit
124.输出数字
代码
1 2 3 4 5 6 7 8
Dim a(20) For i = 1 To 20 a(i) = Int(Rnd * (1000 - 0 + 1)) + 0 If a(i) > 500 Then s = s + a(i) End If Next Print s
s = 0 For i = 1 To 10000 For j = 1 To i - 1 If i Mod j = 0 Then s = s + j End If Next If s = i Then Print i End If s = 0 Next
126.掷骰子
如图,编程出如下效果
代码
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
Text1 = "": Text2 = "" n = Text3 For i = 1 To n Randomize s = Int(Rnd * (6 - 1 + 1)) + 1 Text1 = Text1 & "您第" & i & "次转到了" & s & "号骰子" + Chr(13) + Chr(10) If s = 1 Then a = a + 1 If s = 2 Then b = b + 1 If s = 3 Then c = c + 1 If s = 4 Then d = d + 1 If s = 5 Then e = e + 1 If s = 6 Then f = f + 1 Next Text2 = "1号骰子出现的次数为" & a & "次" + Chr(13) + Chr(10) Text2 = Text2 & "2号骰子出现的次数为" & b & "次" + Chr(13) + Chr(10) Text2 = Text2 & "3号骰子出现的次数为" & c & "次" + Chr(13) + Chr(10) Text2 = Text2 & "4号骰子出现的次数为" & d & "次" + Chr(13) + Chr(10) Text2 = Text2 & "5号骰子出现的次数为" & e & "次" + Chr(13) + Chr(10) Text2 = Text2 & "6号骰子出现的次数为" & f & "次" + Chr(13) + Chr(10)
Dim a(), b(6) As Integer Text1 = "": Text2 = "" n = Text3 ReDim a(n) For i = 1 To n Randomize a(i) = Int(Rnd * (6 - 1 + 1)) + 1 Text1 = Text1 & "您第" & i & "次转到了" & a(i) & "号骰子" + Chr(13) + Chr(10) Select Case a(i) Case 1 b(1) = b(1) + 1 Case 2 b(2) = b(2) + 1 Case 3 b(3) = b(3) + 1 Case 4 b(4) = b(4) + 1 Case 5 b(5) = b(5) + 1 Case 6 b(6) = b(6) + 1 End Select Next For i = 1 To 6 Text2 = Text2 & i & "号骰子出现的次数为" & b(i) & "次" & vbCrLf Next
127.杨辉三角
代码
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
Dim a() As Long n = 11 ReDim a(n, n) For i = 1 To n a(i, i) = 1 a(i, 1) = 1 Next For i = 3 To n For j = 2 To i - 1 a(i, j) = a(i - 1, j - 1) + a(i - 1, j) Next Next For i = 1 To n Print Space(n - i); For j = 1 To i Print Space(1) & Format(a(i, j), "@@@"); Next Print Next
Cls ' 获取行数 Dim n As Integer n = Val(Text1.Text) ' 定义杨辉三角的行与列 Dim a As Integer, b As Integer a = n b = 2 * a - 1 ' 定义数组的行与列,根据杨辉三角的行与列,动态生成二维数组 Dim arr() As Integer ReDim arr(a, b) As Integer ' 第一行需要单独赋值,且赋值在中间 ' 列 = 杨辉三角的列 \ 2 + 1 arr(1, b \ 2 + 1) = 1 For i = 2 To a Step 1 For j = 1 To b - 1 Step 1 ' 每一个值 = 上一行的前一个值+上一行的后一个值 arr(i, j) = arr(i - 1, j - 1) + arr(i - 1, j + 1) Next j Next i ' 为最后一个元素赋值 arr(a, b) = 1 ' 输出测试 For i = 1 To a Step 1 For j = 1 To b Step 1 If arr(i, j) = 0 Then Print " "; ' 控制格式 Else Print arr(i, j); End If Next j Print Next i
128.进制转换
十进制转二进制,界面自定
除二取余,逆序输出
(D->B)
代码
1 2 3 4 5 6
Do Until n = 0 r = n Mod 2 s = Str(r) + s n = n \ 2 Loop Print s
(B->D)
代码
1 2 3 4 5 6 7 8
s = 111 n = Len(s) p = 0 For i = 1 To n ch = Mid(s, i, 1) p = p + Val(ch) * 2 ^ (n - i) Next Print p
n = 282132138 Do While n > 0 r = n Mod 16 If r <= 9 Then s = Str(r) + s Else s = Chr(r + 55) + s End If n = n \ 16 Loop Print s; Print Hex(282132138); s1 = "0123456789ABCDEF" n = 564654 s = "" Do While n > 0 r = n Mod 16 s = Mid(s1, r + 1, 1) + s n = n \ 16 Loop Print s
Cls Text1 = "" Dim a(5, 5) For i = 1 To 5 For j = 1 To 5 a(i, j) = Int(Rnd * (99 - 10 + 1)) + 10 Text1 = Text1 & a(i, j) & Space(1) If j Mod 5 = 0 Then Text1 = Text1 + Chr(13) + Chr(10) End If Next Next For i = 1 To 5 z = z & a(i, i) & Space(1) sz = sz + a(i, i) For j = 1 To 5 If 6 - i = j Then f = f & a(i, j) & Space(1) fz = fz + a(i, j) End If Next Next Print "主对角线:" & z Print "副对角线:" & f Print "主对角线和:" & sz Print "副对角线和:" & fz Print "交换前:" For i = 1 To 5 For j = 1 To 5 Print a(i, j); Next Print Next Print Print "交换后:" For i = 1 To 5 For j = 1 To 5 t = a(2, j) a(2, j) = a(4, j) a(4, j) = t Next Next For i = 1 To 5 For j = 1 To 5 Print a(i, j); Next Print Next
BMI = Text1.Text Select Case BMI Case "偏瘦" Print "BMI<18.5" Case "正常" Print "18.5<=BMI<24" Case "偏胖" Print "24<=BMI<28" Case "肥胖" Print "28<=BMI<40" Case "极重度肥胖" Print "BMI>=40" Case Val(BMI) < 18.5 Print "偏瘦" Case Val(BMI) >= 18.5 And Val(BMI) < 24 Print "正常" Case Val(BMI) >= 24 And Val(BMI) < 28 Print "偏胖" Case Val(BMI) >= 28 And Val(BMI) < 40 Print "肥胖" Case Val(BMI) >= 40 Print "极重度肥胖" End Select
133.计算天数
代码
1 2 3 4 5 6 7
n = Val(Text1) ano = n \ 365 mes = Int((n - Int(n \ 365) * 365) / 30) dia = n - Int(n \ 365) * 365 - Int(((n - Int(n \ 365) * 365) \ 30) * 30) Print ano & " ano(s)" Print mes & " mes(es)" Print dia & " dia(s)"
134.统计字符串
代码
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
Cls s = Text1 For i = 1 To Len(s) res = Mid(s, i, 1) If res Like "[A-Z]" Then letter = letter + 1 ElseIf res Like "[a-z]" Then letter = letter + 1 ElseIf res Like "[0-9]" Then Numbers = Numbers + 1 ElseIf res = " " Then spaces = spaces + 1 Else others = others + 1 End If Next Print "Letter: " & letter & " Numbers: " & Numbers _ & " Spaces: " & spaces & " Others: " & others
Dim a(1 To 26) Dim max As Integer n = Len(Text1) For i = 1 To n res = Asc(Mid$(Text1, i, 1)) If (res >= 65 And res <= 90) Then a(res - 64) = a(res - 64) + 1 End If If (res >= 97 And res <= 122) Then a(res - 96) = a(res - 96) + 1 End If Next max = 0 For i = 1 To 26 If max < a(i) Then max = a(i) End If Next For i = 1 To 26 If a(i) = max Then l = i End If Next Print "最多的英文字母:" & Chr(l + 96) Print "出现的次数:" & Str(max)
136.算数
代码
1 2 3 4 5 6 7 8 9 10
n = Val(Text1.Text) s = 1 For i = 1 To n If i Mod 2 = 0 Then s = s + (1 / (s + 3)) Else s = s - (1 / (s + 3)) End If Next Print 1 - s
137.数组对调
举个例子:a(1,2,3,4,5) 把对调后的数组放到数组b(5,4,3,2,1)
代码
1 2 3 4 5 6 7 8 9 10 11 12
Dim a(10), b(10) As Integer Print "对调前:" For i = 1 To 10 a(i) = Int(Rnd * (99 - 10 + 1)) + 10 Print a(i); Next Print Print "对调后:" For i = 1 To 10 b(i) = a(11 - i) Print b(i); Next
Cls Dim n As Integer, a() As Long n = 5 ReDim a(n, n) For i = 1 To n For j = 1 To n a(i, j) = Int(Rnd * (99 - 10 + 1)) + 10 Print a(i, j); Next PrintQ Next Dim z, f As String Max = a(1, 1): Min = a(1, 1) For i = 1 To n z = z & a(i, i) & Space(1) f = f & a(i, n + 1 - i) & Space(1) If a(i, i) < Min Then Min = a(i, i) If a(i, n + 1 - i) > Max Then Max = a(i, n + 1 - i) Next Print "主对角线:" & z Print "主对角线最小元素:" & Min Print "副对角线:" & f Print "副对角线最大元素:" & Max
For i = 2 To 300 For j = 2 To i - 1 If i Mod j = 0 Then Exit For End If Next j If j > i - 1 Then n = n + 1 Print i; If n Mod 5 = 0 Then Print End If Next i
参考答案
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
Dim a(300) For i = 1 To 300 a(i) = i Next For i = 1 To 300 s = 0 For j = 1 To 300 - i If a(i) Mod j = 0 Then s = s + 1 End If Next If s = 2 Then Print a(i); n = n + 1 If n Mod 5 = 0 Then Print End If Next
142.分段函数
代码
1 2 3 4 5 6 7 8 9 10
x = Val(InputBox("x")) z = Val(InputBox("y")) If x >= -10 And z < 0 Then y = x ^ 2 + z ^ 2 ElseIf x < -30 And z > 0 Then y = x / z ElseIf x >= -30 And x < -10 Or x > z Then y = Sqr(x - z) End If Print y
143.分段函数
代码
1 2 3 4 5 6 7 8 9 10
x = Val(InputBox("x")) y = Val(InputBox("y")) If x > y And y >= 1 Then z = Sqr(x ^ 2 - y ^ 2) ElseIf x = 0 Then z = 0 ElseIf x < -1 Then z = Abs(x) End If Print z
Private Sub Command1_Click() Dim flag As Boolean For i = 1 To List1.ListCount - 1 resName = List1.List(i) nSpace = InStr(List1.List(i), " ") nName = Trim(Left(List1.List(i), nSpace - 1)) If Trim(Text1) = nName Then price = Val(Right(List1.List(i), 4)) flag = True Exit For End If Next If flag = True Then Text3 = Val(Text2) * price Else Text3 = "无此商品" End If End Sub Private Sub Form_Load() List1.AddItem "名称 单价" List1.AddItem "纯净水 1.00" List1.AddItem "面包 3.10" List1.AddItem "方便面 1.20" List1.AddItem "巧克力 5.50" List1.AddItem "冰激凌 4.22" List1.AddItem "酸奶 2.35" List1.AddItem "果汁 7.50" List1.AddItem "烤鸡翅 15.2" List1.AddItem "奶油蛋糕 9.60" End Sub
145.统计最长字母
代码
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
Cls Dim a(1 To 26), key As Integer For i = 1 To Len(Text1) res = LCase(Mid(Text1, i, 1)) If res >= "a" And res <= "z" Then t = Asc(res) - 96 a(t) = a(t) + 1 End If Next max = 0 For i = 1 To 26 If a(i) > max Then max = a(i) key = i End If Next Print "出现次数最多的字母是:" & Chr(key + 96) Print "它出现的次数为:" & max
Public num, n As Integer Const c = 5 Private Sub Command1_Click() Dim m, n As Integer m = InputBox("m到n", "请输入数字") n = InputBox(m & "到m") If m < n Then t = m: m = n: n = t num = Int(Rnd * (n - m + 1)) + m Label1 = n & "~" & m & "之间" End Sub Private Sub Command2_Click() guess = Val(Text1.Text) If guess <> num Then n = n + 1 If guess > num Then MsgBox "太大了!" Else MsgBox "太小了!" End If If n = c Then MsgBox "次数到了!" End End If Else MsgBox "猜对了!", vbInformation End If Print n End Sub
150.列表判断
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
Private Sub Command1_Click() For i = 1 To 10 a(i) = Int(Rnd * (99 - 10 + 1)) + 10 List1.AddItem a(i) Next End Sub Private Sub Command2_Click() i = 0 While i < List1.ListCount - 1 If List1.List(i) Mod 2 = 0 Then List2.AddItem List1.List(i) List1.RemoveItem i i = 0 Else i = i + 1 End If Wend End Sub