-
1
、设计采用欧几里德算法求解两个自然数的最大公约数的程序。
Private Sub command1_click()
Dim m As Long, n As Long
Dim r As Long
m =
Val()
n = Val()
If m < 1 Or n < 1 Then
=
数据错误
Else
Do
r = m
Mod n
m = n
n = r
Loop Until r = 0
= CStr(m)
End If
End Sub
2
、从由字母、数字
组成的字符串中找出所有大写字母并逆序输出的程序
Private Sub Command1_Click()
Dim s As String, d As String, t As
String
Dim i As Integer
us
s =
For i = 1 To Len(s)
If Mid(s, i, 1) >=
t = t &
Mid(s, i, 1)
End If
Next i
For i = Len(t) To 1 Step -1
d = d & Mid(t, i, 1)
Next i
= d
End Sub
3
、
编写程序，
找出所有三位水仙花数。
所谓水仙花，
是指各位数字的立方和等于该
数
本身的数。例如，
153=1^3+5^3+3^3
，
,
所以
153
是一个水
仙花数。
Option Explicit
Private Sub command1_click()
Dim I As Integer, a As Integer, b As
Integer, c As Integer
Dim st As String
For a = 1 To 9
For b = 0 To
9
For c = 0 To 9
I = a *
100 + b * 10 + c
If I = a ^ 3 + b ^
3 + c ^ 3 Then
st = I &
m st
End If
Next c
Next b
Next a
End Sub
4
、将一个二进制数原码转换成补码。
Option Explicit
Private Sub command1_click()
Dim source As String, I As Integer
Dim D As String * 1
source =
If Mid(source, 1, 1) <>
= source
=
source
Else
For I = Len(source) To 2
Step -1
If Mid(source, I, 1) =
Mid(source, I, 1) =
Else
Mid(source, I, 1) =
End If
Next I
= source
= source
D =
For
I = Len(source) To 2 Step -1
If Mid(source,
I, 1) =
Mid(source, I, 1) =
D =
ElseIf Mid(source, I, 1) =
Mid(source, I,
1) =
D =
End
If
Next I
= source
End If
End Sub
5
、编写程序，随机
生成
100
个两位整数，并统计出其中小于等于
40
、大于
40
小于等
于
70
及大于
70<
/p>
的数据个数。
Private Sub
command1_click()
Dim I As Integer
Dim s As Integer
Dim s1 As
Integer
Dim s2 As Integer
Dim s3 As Integer
For I = 1
To 100
s = Int(Rnd * 90 + 10)
Select Case s
Case Is <= 40
s1 = s1 +
1
Case Is <= 70
s2 = s2 + 1
Case Else
s3 = s3 + 1
End Select
Next I
=
CStr(s1)
= CStr(s2)
=
CStr(s3)
End Sub
6
、编写程序，输入正整数
n,
求其对应的二进制数。
Private Sub command1_click()
Dim s As String
Dim t As
Integer
t = V
al()
Do While t <> 0
s = CStr(t Mod 2) + s
t =
t 2
Loop
= s
End Sub
7
、
编写程序，
求出
100
之内的
所有勾股数。
所谓勾股数，
是指满足条件
a^2+b^2=c^2
(a <>b)
的自然数。
Private Sub Command1_Click()
Dim a As Integer
Dim b As
Integer
Dim c As Integer
For
a = 1 To 100
For b = a + 1 To 100
For c = b + 1 To 100
If a ^ 2 + b ^ 2 = c ^ 2
Then
m
CStr(c)
&
&
CStr(a)
&
&
CStr(b)
&
End If
Next c
Next b
Next a
End Sub
8<
/p>
、设计一个用二分法求方程
x^3-x^4+4x^2-1=0<
/p>
在区间【
0.
，
1
】上的一个实根。算法
提示：
若方程
f(x)=0
在区间
【
a,b
】
上有一个实根，
则<
/p>
f(a)
与
f(b)
必然异号，
即
f(a)*f(b)<0;
< br>设
c= (a+b)/2,
若
f
(a)*
f(c)>0,
则令
a=c,
否则令
b=c
。
当
b-c
的绝对值小于或等于给定误差
要求时，则
c
就是要求的根。
Private Function f(x As Single) As
Double
f = x ^ 3 - x ^ 4 + 4 * x ^ 2 -
1
End Function
Private Sub
Command1_Click()
Dim a As Single '
Dim b As Single
Dim c As
Single
a = 0: b = 1
If f(a)
* f(b) < 0 Then
Do
c =
(a + b) / 2
If f(a) * f(c)
> 0 Then
a = c
Else
b = c
End If
Loop Until
Abs(b - c) < 0.000001 And f(b) * f(c) < 0
End If
Print c
End Sub
9
、找出
100
以内的所有素数，存放在数组
Prime
中，并将所找到的素数按每行
10
个<
/p>
的形式显示在窗体上。
Option
Base 1
Option Explicit
Private Sub form_click()
Dim
prime(50) As Integer, I As Integer
Dim
k As Integer, m As Integer, j As Integer
prime(1) = 2
m = 1
For I = 3 To 99 Step 2
For
k = 2 To Sqr(I)
If I Mod k = 0
Then Exit For
Next k
If
k > Sqr(I) Then
m = m + 1
prime(m) = I
End If
Next I
k =
0
For j = 1 To m
k =
k + 1
Print prime(j);
If
k Mod 10 = 0 Then Print
Next j
End Sub
10
、随即生成
10
个两两互质的数，并按从小到大的顺序存放在
< br>listbox
中
.
。
Option Explicit
Private Sub command1_click()
Dim p As Integer, I As Integer, idx As
Integer
Dim j As Integer
(0)
= Int(Rnd * (9999 - 1000)) + 1000
Do
p =
Int(Rnd * (9999 - 1000)) + 1000
For I = 0 To
unt - 1
For j = 2 To p
If p Mod j = 0 And (I) Mod
j = 0 Then
Exit For
End If
Next j
If
j <= p Then Exit For
Next I
If I > unt - 1
Then
idx
= 0
Do
While p < (idx)
idx
= idx + 1
If idx > unt -
1 Then Exit Do
Loop
m p, idx
End If
Loop
Until unt = 10
End Sub
11
、随机生成
10
个
1
-99
的整数，用选择法对
10
个数进
行排序。
Option Explicit
Option Base 1
Private Sub
cmdsort_click()
Dim sort(10) As
Integer, temp As Integer
Dim I As
Integer, j As Integer
Randomize
For I = 1 To 10
sort(I)
= Int(Rnd * (100 - 1)) + 1
Text1 =
Text1 & Str(sort(I))
Next I
For I = 1 To 9
For j = I
+ 1 To 10
If sort(I) > sort(j)
Then
temp = sort(I)
sort(I) = sort(j)
sort(j) = temp
End If
Next j
Text2
= Text2 & Str(sort(I))
Next I
Text2 = Text2 & Str(sort(I))
End Sub
12
、编写程序实现顺序查找的功能。
Option Explicit
Option Base
1
Dim search As V
ariant
Private Sub Command2_Click()
Dim I As Integer, find As Integer
Text2 =
find = InputBox(
输入要查找的数
For I = 1 To
UBound(search)
If search(I) = find
Then Exit For
Next I
If I <=
UBound(search) Then
Text2 =
要查找的数
是
search(
Else
Text2 =
在数列中没有找到
End If
End Sub
Private Sub
Command1_Click()
Dim I As Integer,
Element As Variant
search = Array(34,
12, 56, 81, 74, 59, 83, 91, 26)
For
Each Element In search
Text1 =
Text1 & Str(Element)
Next Element
End Sub
13
、编写程序实现二分查找功能。
Option Explicit
Option Base
1
Dim search As V
ariant
Private Sub Command1_Click()
Dim v As V
ariant
search = Array(12, 17, 23, 28, 30, 39,
41, 46, 57, 61, 78, 83, 85, 89, 93)
For
Each v In search
Text1 = Text1 &
Str(v)
Next v
End Sub
Private Sub Command2_Click()
Dim left As Integer, right As Integer
Dim mid As Integer, flg As Boolean
Dim find As Integer
find = I
nputBox(
输入要查找的数
le
ft = 1: right = UBound(search)
flg =
False
Do While left <= right
mid = (right + left) / 2
If search(mid) = find Then
flg =
True
Exit Do
ElseIf
find > search(mid) Then
left =
mid + 1
Else
right
= mid - 1
End If
Loop
If flg Then
Text2 =
要查找的数
在
searc
h(
中
Else
Text2 = Str(find) &
不在数组中
End If
End Sub
14
、
设
A
是
3*2
的矩阵，
B
是
2*3
的矩阵，求
A*B
。
Option Explicit
Option Base
1
Dim Idx As Integer
Dim
A(3, 2) As Integer, B(2, 3) As Integer
Dim C(3, 3) As Integer
Private Sub Command1_Click()
Dim I As Integer, J As Integer
Dim t As Integer
For I = 1
To 3
For J = 1 To 2
A(I, J) = Text1(t)
t =
t + 1
Next J
Next I
t = 0
For I = 1 To 2
For J = 1 To 3
-
-
-
-
-
-
-
-
-
上一篇：国内外英语写作的研究现状及意义
下一篇：实体联系图示例