第1题
'题目10相正整数中剔干数保留数中
' 意两数方数
'(谓方数该数等某数方例4方数)
Option Explicit
Option Base 1
Private Sub Command1_Click()
Dim a(10) As Integer i As Integer j As Integer p As Integer k As Integer
'**********FOUND**********
Do While p < 10
k Int(20 * Rnd) + 1
For j 1 To p
'**********FOUND**********
If k a(j) Then Exit Do
Next j
If j > p Then
p p + 1
a(p) k
Text1 Text1 & Str(k)
End If
Loop
Call delete(a p)
For i 1 To p
Text2 Text2 & Str(a(i))
Next i
End Sub
Private Sub delete(a() As Integer p As Integer)
Dim idx As Integer j As Integer sum As Integer
idx 2
Do While idx < p
For j 1 To idx 1
sum a(idx) + a(j)
If Int(Sqr(sum)) Sqr(sum) Then Exit For
Next j
'**********FOUND**********
If j > idx 1 Then
a(idx) a(p)
p p 1
Else
idx idx + 1
End If
Loop
End Sub
答案:
(答案1)
Do While p < 10
(答案2)
If k a(j) Then Exit For
(答案3)
If j < idx 1 Then
第2题
'题目程序功生成组(10)两位互质数
'组互质数指中意两数间存1外公约数
Private Sub Command1_Click()
Dim i As Integer k As Integer num(10) As Integer
Dim flag As Boolean n As Integer
num(1) Int(Rnd * 90) + 10
k 1
Do
'**********FOUND**********
flag True
n Int(Rnd * 90) + 10
For i 1 To k
If gcd(num(i) n) <> 1 Then flag False
Next i
If flag Then
k k + 1
num(k) n
End If
Loop Until k 10
For i 1 To 10
Text1 Text1 & Str(num(i))
Next i
End Sub
'**********FOUND**********
Private Function gcd(m ByVal n) As Integer
Dim r As Integer
Do
r m Mod n
m n
n r
Loop Until r 0
'**********FOUND**********
gcd n
End Function
答案:
(答案1)
flag False
(答案2)
Private Function gcd(ByVal m ByVal n) As Integer
(答案3)
gcd m
第3题
'题目程序功:10~20范围数分表示成干质子连形式
Option Explicit
Option Base 1
Private Sub Command1_Click()
Dim j As Integer pf() As Integer i As Integer
Dim st As String
For i 10 To 20
Call prime_f(i pf)
st CStr(i) &
'**********FOUND**********
For j 1 To UBound(pf)
st st & Str(pf(j)) & *
Next j
st st & Str(pf(j))
List1AddItem st
Next i
End Sub
'**********FOUND**********
Private Sub prime_f(n As Integer a() As Integer)
Dim i As Integer k As Integer
i 2
Do
If n Mod i 0 Then
k k + 1
ReDim Preserve a(k)
a(k) i
n n \ i
Else
i i + 1
End If
'**********FOUND**********
Loop Until n < 0
End Sub
答案:
(答案1)
For j 1 To UBound(pf) 1
(答案2)
Private Sub prime_f(ByVal n As Integer a() As Integer)
(答案3)
Loop Until n < 1
第4题
'[题目]程序功:查找8001200范围具两相数字素数
'例811877等符合求数
Option Explicit
Private Sub Command1_Click()
Dim i As Integer
For i 800 To 1200
If validate(i) And prime(i) Then
List1AddItem i
End If
Next i
End Sub
'**********FOUND**********
Private Function validate(n As Integer) As Boolean
Dim num() As Integer k As Integer
Dim i As Integer j As Integer
Do
k k + 1
'**********FOUND**********
ReDim num(k)
num(k) n Mod 10
n n \ 10
Loop Until n < 0
k 0
For i 1 To UBound(num) 1
For j i + 1 To UBound(num)
If num(i) num(j) Then k k + 1
Next j
Next
If k 1 Then validate True
End Function
Private Function prime(n As Integer) As Boolean
Dim i As Integer
For i 2 To Sqr(n)
'**********FOUND**********
If n Mod i 0 Then Exit For
Next i
prime True
End Function
答案:
(答案1)
Private Function validate(Byval n As Integer) As Boolean
(答案2)
ReDim Preserve num(k)
(答案3)
If n Mod i 0 Then Exit Function
第5题
'题目:程序功查找定范围满足条件整数数
'条件1整数位数字相数字0
'条件2第二数等第数两倍
'例123246符合条件数
Option Explicit
Private Sub Command1_Click()
Dim i As Integer
Dim n As Integer
For i 123 To 5678
n i * 2
If fun(i) And fun(n) Then
List1AddItem ( & i & & n & )
End If
Next i
End Sub
'**********FOUND**********
Private Function fun(n As Integer) As Boolean
Dim a() As Integer i As Integer j As Integer
Do
i i + 1
ReDim Preserve a(i)
a(i) n Mod 10
If a(i) 0 Then Exit Function
n n \ 10
'**********FOUND**********
Loop Until n < 0
For i 1 To UBound(a) 1
For j i + 1 To UBound(a)
'**********FOUND**********
If a(i) a(j) Then Exit For
Next j
Next i
fun True
End Function
答案:
(答案1)
Private Function fun(ByVal n As Integer) As Boolean
(答案2)
Loop Until n 0
(答案3)
If a(i) a(j) Then Exit Function
第6题
'[题目]程序功:机生成n元素数组(ninputBox函数)
'找出中元素删输出删数组
Option Explicit
Option Base 1
Dim a() As Integer n As Integer
Private Sub Command1_Click()
Dim i As Integer
n InputBox(请输入数组数 10)
ReDim a(n)
For i 1 To n
a(i) Int(Rnd * 100) + 1
Text1 Text1 & Str(a(i))
Next i
Call Lookup(a)
'**********FOUND**********
For i 1 To n
Text2 Text2 & Str(a(i))
Next i
End Sub
Private Sub Lookup(a() As Integer)
Dim Maxv As Integer maxp As Integer i As Integer
Maxv a(1) maxp 1
For i 2 To n
If a(i) > Maxv Then
Maxv a(i) maxp i
End If
Next i
Call move_f(a maxp)
End Sub
Private Sub move_f(a() As Integer k As Integer)
Dim i As Integer
For i k + 1 To UBound(a)
'**********FOUND**********
a(i) a(i + 1)
Next i
'**********FOUND**********
ReDim a(UBound(a) 1)
End Sub
答案:
(答案1)
For i 1 To n1
(答案2)
a(i1) a(i)
(答案3)
ReDim Preserve a(UBound(a) 1)
第7题
'题目程序功:找出介100999间三数字组成完全方数
'谓完全方数指方根整数数例529位数字方根23
'529符合求数
Option Explicit
Option Base 1
Private Sub Command1_Click()
Dim i As Integer p As Single
For i 100 To 999
If pf(i) And verify(i) Then
p Sqr(i)
List1AddItem i & & p & * & p
End If
Next i
End Sub
Private Function pf(n As Integer) As Boolean
If Sqr(n) Int(Sqr(n)) Then pf True
End Function
'**********FOUND**********
Private Function verify(n As Integer) As Boolean
Dim a() As Integer k As Integer i As Integer j As Integer
Do
k k + 1
ReDim Preserve a(k)
a(k) n Mod 10
n n \ 10
'**********FOUND**********
Loop Until n < 0
For i 1 To UBound(a) 1
For j i + 1 To UBound(a)
'**********FOUND**********
If a(i) a(j) Then Exit For
Next j
Next i
verify True
End Function
答案:
(答案1)
Private Function verify(ByVal n As Integer) As Boolean
(答案2)
Loop Until n < 0
(答案3)
If a(i) a(j) Then Exit Function
《香当网》用户分享的内容,不代表《香当网》观点或立场,请自行判断内容的真实性和可靠性!
该内容是文档的文本内容,更好的格式请下载文档