VB算法特训营(三)

这真的很重要!关于题目版权声明及部分事项 ? 戳它进行查看

101.列表框综合

img

代码(沙雕版)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
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

[collapse title=”以前的”]

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
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

[/collapse]

[collapse title=”参考答案(Sansmall)”]

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
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.顺序查找

img

代码

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

[collapse title=”旧的代码”]

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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.输出素数

img

代码

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.打印图形

img

img img

代码

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函数)

img

代码

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.打印成绩

img

代码

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

img

代码

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 & "人"

107.数组练习

img

代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
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.计算阶乘

img

代码

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.平均分

img

代码

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.统计人口

img

代码

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.计时器

img

代码

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.滚动控件

img

代码

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.求最大最小值

img

代码

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.计算类别

img

代码

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.加密

img

代码

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.计算折扣价

img

代码

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.分段函数

img

代码

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.输出数组

img

代码

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.统计数字

img

代码

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.输出成绩

img

代码

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.打印题

img

代码

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.鸡兔同笼

img

代码

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.输出数字

img

代码

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

125.完美数(完全数)

如果一个数恰好等于它的真因子之和,则称该数为“完全数”。第一个完全数是6,第二个完全数是28,第三个完全数是496

例如:第一个完全数是6,它有约数1、2、3、6,除去它本身6外,其余3个数相加,1+2+3=6。第二个完全数是28,它有约数1、2、4、7、14、28,除去它本身28外,其余5个数相加,1+2+4+7+14=28。第三个完全数是496,有约数1、2、4、8、16、31、62、124、248、496,除去其本身496外,其余9个数相加,1+2+4+8+16+31+62+124+248=496。后面的完全数还有8128、33550336等等

题目:求出1-10000内的完全数,界面自定

代码

1
2
3
4
5
6
7
8
9
10
11
12
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.掷骰子

如图,编程出如下效果

img

代码

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)

数组版本

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
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.杨辉三角

img

代码

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

参考答案

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
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

(D->H)

代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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

129.二维数组练习

生成一个二维数组(99-10),分别找出主对角线的和和副对角线的和并打印主副对角线的值,并且将二维数组的第二列和第四列进行交换

代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
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

130.秒的换算

如图进行编程

img

小时 = 秒数 \ 60 \ 60
分钟 = 秒数 \ 60 - (小时 * 60)
秒数 = 秒数 - (小时6060) - (分钟*60)

小时 = 秒数 \ 3600
分钟 = (秒数 \ 60) mod 60
秒数 = 秒数 mod 60

代码

1
2
3
4
5
6
7
Cls
Dim hour, minute, second As Integer
s = Val(Text1)
hour = s \ 60 \ 60
minute = s \ 60 - hour * 60
second = s - (hour * 60 * 60) - (minute * 60)
Print hour & "时" & minute & "分" & second & "秒"

增强版本

img

代码

1
2
3
4
5
6
7
8
Dim hour, minute, second, day As Double
s = Val(Text1)
day = s \ 60 \ 60 \ 24
hour = s \ 60 \ 60 - (day * 24)
minute = s \ 60 - (day * 24 * 60) - (hour * 60)
second = s - (day * 24 * 60 * 60) - (hour * 60 * 60) - (minute * 60)
Print hour & "时" & minute & "分" & second & "秒"
Print day & "天" & hour & "时" & minute & "分" & second & "秒"

131.计算n

计算:n+nn+nnn+nnn….

输入一个数,然后打印如下结果

e.g:输入a=1,n=5,返回1+11+111+1111+11111=12345

e.g:输入a=12,n=5,返回12+1212+121212+12121212+1212121212=1224364860

img

代码

[hidden]我是伞兵[/hidden]

1
2
3
4
5
6
7
8
9
10
11
12
a = 1
n = 5
For i = 1 To n
t = t & CStr(a)
s = s + Int(t)
If n = i Then
Print Trim(t) & "=";
Else
Print Trim(t) & "+";
End If
Next
Print Trim(s);

132.判断体制

img

代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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.计算天数

img

代码

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.统计字符串

img

代码

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

135.统计字符

现有数据“1238127389aaajnasasdjasndaaa”,现在统计出这个数据里边出现最多的英文字母,并计算出他的个数

img

代码

参考答案

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
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.算数

img

代码

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

138.找出最近素数

对于任意输入一个大于10的偶数y,找出最靠近y的素数

代码

139.求相亲数

相亲数(亲和数):任意一组整数,整数1到10000,整数A的真因子和等于整数B,整数B的真因子和等于整数A,则称这一组整数为相亲数,如果220 和 284

两个正整数全部约数和与另一相等

求1000以内的相亲数

代码

这题

140.找对角线最大值

生产一个N行N列由两位随机整数组成的二维数组,找出主对角线上的最小元素和副对角线上的最大元素,为了方便查看,同时输出主对角线和副对角线

代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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

拓展题目

生产一个N行N列由两位随机整数组成的二维数组,找出主对角线上的最小元素和副对角线上的最大元素(倒过来),为了方便查看,同时输出主对角线和副对角线

img

141.输出素数

img

代码

1
2
3
4
5
6
7
8
9
10
11
12
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.分段函数

img

代码

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.分段函数

img

代码

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

144.商品购买

img

代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
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.统计最长字母

img

代码

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

146.角谷猜想

所谓角谷猜想,是指对于任意一个正整数,如果是奇数,则乘3加1,如果是偶数,则除以2,得到的结果再按照上述规则重复处理,最终总能够得到1。如,假定初始整数为5,计算过程分别为16、8、4、2、1。

代码

1
2
3
4
5
6
7
8
9
10
i = 0
s = Val(Text1)
Do Until s = 1
If s Mod 2 = 0 Then
s = s / 2
Else
s = s * 3 + 1
End If
Print s
Loop

147.折叠次数

img

打开考生文件夹内 vb3 文件夹下的“工程 1.vbp”文件进行设计,界面如图所示。有一张足够大的纸,其厚度为0.1mm,问经过多少次对折,其厚度超过珠穆朗玛峰高度8848m?

1
2
3
4
5
6
7
i = 0
s = 1
Do While (s < 8844# * 1000)
i = i + 1
s = (2 ^ i) * 0.1
Loop
Print "折叠次数:" & i & "," & "厚度为:" & Format(s / 1000, "#####.####")

148.滚动字幕

img

1
Label1 = Mid(Label1, 2, Len(Label1) - 1) + Left(Label1, 1) ' Timer里边加

149.猜数字

img

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
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.列表判断

img

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
Author

IceCliffs

Posted on

2021-02-12

Updated on

2024-12-03

Licensed under

Comments