【题目1】找出10至100之间的互质数（即这些数中任意两个数的最大公约数为1）。

答：

源程序：

Private Sub Command1_Click()

    Dim A() As Integer, I As Integer, J As Integer, Logic As Boolean

    Dim K As Integer

    ReDim A(1)

    A(1) = 10

    K = 1

    For I = 11 To 100

        Logic = False

        Call Sub1(A, I, Logic)

        If Logic Then

            K = K + 1

            ReDim Preserve A(K)

            A(K) = I

        End If

    Next I

    For I = 1 To UBound(A)

          Text1 = Text1 & Str(A(I))

          If I Mod 5 = 0 Then Text1 = Text1 & vbCrLf

    Next I

End Sub

 

Private Sub Sub1(A() As Integer, N As Integer, F As Boolean)

    Dim I As Integer, J As Integer, Ub As Integer

    Ub = UBound(A)

    For I = 1 To Ub

          For J = 2 To A(I)

              If A(I) Mod J = 0 And N Mod J = 0 Then

                  Exit Sub

              End If

          Next J

        

    Next I

    F = True

End Sub

 

【题目2】本程序功能是：随机生成15个3位正整数，找出其中的升序数并移动放置到数列的左端；非升序数放置在数列右边。升序数是指其各位数字从高位到低位，一个比一个大的整数，如134、257、389等均为升序数。

答：

源程序：

Option Explicit

Private Sub Command1_Click()

    Dim a(15) As Integer, i As Integer

    Dim st As String, t As Integer, J As Integer

    Randomize

    For i = 1 To 15

        a(i) = Int(Rnd * 900) + 100

        st = st & Str(a(i))

    Next i

    Text1 = st

    For i = 1 To 15

        If flag(a(i)) Then

            t = a(i)

            For J = i - 1 To 1 Step -1

                a(J + 1) = a(J)

            Next J

            a(1) = t

        End If

    Next i

    st = ""

    For i = 1 To 15

        st = st & Str(a(i))

    Next i

    Text2 = st

End Sub

Private Function flag(ByVal N As Integer) As Boolean

    Dim i As Integer, a(3) As Integer

    For i = 1 To 3

a(i) = Mid(CStr(N), i, 1)

Next i

If a(1) < a(2) And a(2) < a(3) Then

flag = True

Else

flag = False

End If

End Function

 

【题目3】找出50以内的所有不可表示成两个平方数之和的数。
【编程要求】
1、 按“开始”按钮，则开始运行程序，按图示格式将符合条件的数显示在多行文本框中，每行显示5个数；按“清理”按钮，则将文本框清空；按“结束”按钮，结束程序运行；
2、 程序至少要有一个通用过程，该过程的功能是判断一个数是否是平方数；
3、 显示在文本框中的数据必须按参考界面中的形式对齐。

答：

源程序：

Private Sub Command1_Click()

   Dim i As Integer

   For i = 1 To 50

      If Not flg(i) Then

         Text1.Text = Text1.Text & Str(i) & "  "

         If Len(CStr(i)) = 1 Then Text1.Text = Text1.Text & " "

        

         m = m + 1

         If m Mod 5 = 0 Then Text1.Text = Text1.Text & vbCrLf

      End If

   Next

       

End Sub

 

Public Function flg(i As Integer) As Boolean

flg = False

For J = 1 To Sqr(50)

         For k = 1 To Sqr(50)

            If i = J ^ 2 + k ^ 2 Then

                flg = True

                Exit Function

            End If

          Next k

      Next J

End Function

 

Private Sub Command2_Click()

Text1.Text = ""

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

【题目4】分离数字串。从一个由若干个整数及带小数点的实型数组成的数字字符串（各个数之间由非数字字符分隔）中把整型数与实型数分离出来并分别输出到两个列表框中。

答：

源程序：

Private Function flag(s As String) As Boolean

    If InStr(s, ".") = 0 Then

        flag = True

    Else

        flag = False

    End If

End Function

 

Private Sub Command1_Click()

    Dim s As String, st As String, i As Integer

    Dim N As Integer, st1 As String

    s = Text1

    For i = 1 To Len(s)

        st1 = Mid(s, i, 1)

        If st1 >= "0" And st1 <= "9" Or st1 = "." Then

            st = st & st1

        Else

            If st <> "" Then

                If flag(st) Then

                    List1.AddItem st

                Else

                    List2.AddItem st

                End If

            End If

            st = ""

        End If

Next i

If st <> "" Then

    If flag(st) Then

        List1.AddItem st

    Else

        List2.AddItem st

    End If

End If

End Sub

 

【题目5】随机生成15个两位正整数，从中找出所有的素数，并记下它是第几个数，再找出其中最大的素数，并给出它的位置。
【编程要求】
1、 单击“执行”按钮，则随机生成15个两位正整数，并显示在文本框Text1中；然后从中找出所有的素数，并记下它是第几个数，按图示方式显示在列表框List1中，并将其中最大的素数及其位置分别显示在文本框Text2和Text3；
2、 程序中至少包含一个判断某数是否为素数的通用（函数）过程。

答：

源程序：

Private Sub Command1_Click()

   Dim a(15) As Integer, i As Integer, b(15) As Integer

   For i = 1 To 15

      a(i) = Int(Rnd * 90) + 10

      Text1.Text = Text1.Text & Str(a(i))

   Next i

   Call sushu(a, b)

   For i = 1 To 15

      If b(i) <> 0 Then

         List1.AddItem b(i) & "---" & i

      End If

   Next

   For i = 1 To 14

      M = 1

      For J = 2 To 15

         If b(M) < b(J) Then M = J

      Next

   Next

   Text2.Text = b(M)

   Text3.Text = M

End Sub

 

Public Sub sushu(a() As Integer, b() As Integer)

   For i = 1 To 15

      For J = 2 To Sqr(a(i))

         If a(i) Mod J = 0 Then Exit For

      Next J

      If J > i Then b(i) = a(i)

   Next i      

End Sub

 

【题目6】设N>6，A1，A2，A3，……AK是所有小于N且与N互质（即它和N的最大公约数为1）的整数，找出50以内的所有非素数并且满足A2-A1=A3-A2=A4-A3……条件的数。

答：

源程序：

Option Explicit

Private Sub Command1_Click()

    Dim Factor() As Integer, i As Integer, n As Long, flg As Boolean

    n = 7

   

    Do While n <= 50

        flg = False

        Call Prime(Factor, n, flg)

        If flg Then

            Text1 = Text1 & Right(" " & Str(n), 2) & ":"

            For i = 1 To UBound(Factor)

                Text1 = Text1 & Str(Factor(i))

            Next i

            Text1 = Text1 & vbCrLf

        End If

        n = n + 1

    Loop

End Sub

 

Private Sub Prime(F() As Integer, n As Long, Logic As Boolean)

    Dim i As Integer, J As Integer, K As Integer, M As Integer

    ReDim F(1)

    F(1) = 1

    For i = 2 To n - 1

        For J = 2 To i

            If i Mod J = 0 And n Mod J = 0 Then

                  Exit For

            End If

        Next J

        If J > i Then

            ReDim Preserve F(UBound(F) + 1)

            F(UBound(F)) = i

        End If

    Next i

    M = F(2) - F(1)

 

    For i = 2 To UBound(F) - 1

        If M = 1 Or M <> F(i + 1) - F(i) Then Exit Sub

    Next i

    Logic = True

End Sub

 

【题目7】找出50以内的所有的无平方因子数。若一个数不能被大于1的平方数整除，则该数就是一个无平方因子数。
【编程要求】
1、 按“开始”按钮，则开始运行程序，将结果按图示格式显示于多行文本框中，按“清理”按钮，则将文本框清空；按“结束”按钮，结束程序运行；
2、 程序必须包含一个判断因子是否是平方数的通用过程；
3、 显示在文本框中的运行结果必须按参考界面给出的形式对齐。

答：

源程序：

Private Sub Command1_Click()

   Dim a() As Integer, i As Integer

   Text1.Text = Text1.Text & "数据    因子" & vbCrLf

   For i = 1 To 50

      If flg(i, a) Then

         If Len(CStr(i)) = 1 Then Text1 = Text1.Text & " "

         Text1.Text = Text1.Text & Str(i) & ":    "

         For J = 1 To UBound(a)

            Text1.Text = Text1.Text & Str(a(J))

         Next J

         Text1.Text = Text1.Text & vbCrLf

      End If

   Next i

End Sub

 

Public Function flg(n As Integer, a() As Integer) As Boolean

   ReDim a(1)

   a(1) = 1

   K = K + 1

   flg = True

   For i = 2 To n

       If n Mod i = 0 And n Mod i ^ 2 <> 0 Then

         ReDim Preserve a(UBound(a) + 1)

         a(UBound(a)) = i

      ElseIf n Mod i = 0 And n Mod i ^ 2 = 0 Then

         flg = False

      End If

    Next i

End Function

 

Private Sub Command2_Click()

Text1.Text = ""

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

【题目8】在给定的4×10二维数组中，从每行中找出与该行其余9个数均互质的数。两个数互质是指它们的最大公约数为1。

答：

源程序：

Option Base 1

Private Sub Command1_Click()

    Dim A(4, 10) As Integer, i As Integer, J As Integer, n As Integer

    Dim B() As Integer

    For i = 1 To 4

          For J = 1 To 10

              A(i, J) = i * 10 + J

              Picture1.Print A(i, J);

          Next J

              Picture1.Print

              Call Sub1(A, i, B)

              For n = 1 To UBound(B)

                  Picture2.Print Str(B(n));

              Next n

                  Picture2.Print

    Next i

End Sub

 

Private Sub Sub1(A() As Integer, i As Integer, B() As Integer)

    Dim M As Integer, J As Integer, K As Integer, L As Boolean

    Dim Idx As Integer

    For J = 1 To 10

        L = True

        For M = 1 To 10

            If J <> M Then

                For K = 2 To A(i, J)

                    If A(i, J) Mod K = 0 And A(i, M) Mod K = 0 Then

                        L = False

                        Exit For

                    End If

                Next K

            End If

            If Not L Then Exit For

        Next M

        If L Then

            Idx = Idx + 1

            ReDim Preserve B(Idx)

            B(Idx) = A(i, J)

        End If

    Next J

End Sub

 

【题目9】找出100至200之间且满足该数等于两个素数之积的所有整数。

答：

源程序：

Option Explicit

Option Base 1

Private Sub Command1_Click()

    Dim I As Integer, Flg As Boolean, S1 As Integer, S2 As Integer

    Dim J As Integer, K As Integer, P() As Integer

    ReDim P(1)

    P(1) = 2

     For I = 3 To 200 Step 2

          For J = 2 To Sqr(I)

              If I Mod J = 0 Then Exit For

          Next J

          If J > Sqr(I) Then

              ReDim Preserve P(UBound(P) + 1)

              P(UBound(P)) = I

          End If

    Next I

    For I = 100 To 200

        If Fun(I, P, S1, S2) Then

            Text1 = Text1 & Str(I) & ":" & Str(S1) & "*" & Str(S2) & vbCrLf

        End If

    Next I

End Sub

 

Private Function Fun(N As Integer, P() As Integer, S1 As Integer, S2 As Integer) As Boolean

     Dim I As Integer, J As Integer, M As Long

    For I = 1 To UBound(P) - 1

          For J = I + 1 To UBound(P)

              M = CLng(P(I)) * P(J)

              If M = N Then

                  S1 = P(I): S2 = P(J)

                  Fun = True

                  Exit Function

                 

              End If

          Next J

    Next I

End Function

 

【题目10】编写程序，找出所有满足下述条件的n位数（n=2、3、4）：当他们乘以数2、3、4、5、6、7、8、9时，其各位数字之和不变。

【编程要求】
1、 运行程序，在文本框Text1中输入数字的位数，按“开始”按钮，则将符合条件的数按图标格式显示在多行文本框Text2中；按“清理”按钮，则将两个文本框清空，并将焦点置于Text1中；按“结束”按钮，结束程序运行；
2、 程序至少要包含一个求某数各位数字之和的通用过程。

答：

源程序：

Private Sub Command1_Click()

   Dim N As Integer, I As Long

   Dim L As Integer, R As Integer

   N = Val(Text1.Text)

   L = 10 ^ (N - 1)  '生成最小n位数 如n=2  L=10

   R = 10 ^ N - 1    '生成最大n位数 如n=2  R=99

   For I = L To R

      Flg = True

      s = sum(I)     '求i的各位数之和

      For J = 2 To 9

         '判断i×j（2,3,4,5…9）的各位数之和与i的各位数之和是否相等

         If s <> sum(I * J) Then

            Flg = False

            Exit For

         End If

      Next

      If Flg = True Then    '只有各位数之和与i的各位数之和相等时flg才为true

         Text2.Text = Text2.Text & I & ":" & vbCrLf

         For J = 2 To 9

            Text2.Text = Text2.Text & Str(I * J)

         Next J

         Text2.Text = Text2.Text & vbCrLf

      End If

   Next I

End Sub

 

Public Function sum(M As Long) As Integer

Dim N As Integer, I As Integer

   N = Len(CStr(M))   '求m的位数

   For I = 1 To N

      sum = sum + Val(Mid(CStr(M), I, 1))

   Next I

End Function

 

Private Sub Command2_Click()

Text1.Text = ""

Text2.Text = ""

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

【题目11】随机生成范围在10至60之间的20个不同的整数，从中找出所有的由三个数构成的组合，使得每个组合中的三个数之和均为110。

答：

源程序：

Option Explicit

Private Sub Command1_Click()

    Dim I As Integer, J As Integer, B() As Integer, K As Integer

    Call Sub1(B)

    For I = 1 To 20

          For J = 1 To 20

              If J > I Then

                  For K = 1 To 20

                      If I <> K And K > J Then

                          If B(I) + B(J) + B(K) = 110 Then

                              List1.AddItem Str(B(I)) & Str(B(J)) & Str(B(K))

                          End If

                      End If

                  Next K

              End If

          Next J

    Next I

End Sub

 

Private Sub Sub1(a() As Integer)

    Dim I As Integer, J As Integer, K As Integer

    I = 1

    ReDim a(I)

    a(I) = Int(51 * Rnd) + 10

    Text1 = Text1 & Str(a(I))

    Do

        K = Int(51 * Rnd) + 10

        For J = I To 1 Step -1

            If K = a(J) Then Exit For

        Next J

        If J < 1 Then

            I = I + 1

            ReDim Preserve a(I)

            a(I) = K

            Text1 = Text1 & Str(K)

            If I Mod 5 = 0 Then Text1 = Text1 & vbCrLf

           

        End If

    Loop While I < 20

End Sub

 

【题目12】编写程序，其功能是：将随机生成的10个3位正整数，按行逐个显示在一个多行文本框中，再判断该数是升序数还是降底数，并将判断结果按图所示显示到列表框中。升序数是指其各位数字从高位到低位，一个比一个大的整数，如134、257、389等均为升序数；降序数则反之。

【编程要求】
1、 按“执行”按钮，则开始运行程序，将10个随机数按图标格式显示在多行文本框Text1中，将判断结果按图示格式显示在列表框List1中；按“清除”按钮，则将文本框和列表框清空；按“退出”按钮，结束程序运行；
2、 程序中至少包含一个判断某数是升序还是降序数的通用（函数）过程。

答：

源程序：

Private Sub Command1_Click()

   Dim a(10) As Integer

   Randomize

   Text1.Text = ""

   List1.Clear

   For I = 1 To 10

      a(I) = Int(Rnd * 900) + 100

      Text1.Text = Text1.Text & a(I) & vbCrLf

      s = st(a(I))

      List1.AddItem s

   Next I

End Sub

 

Public Function st(n As Integer) As String

   Dim a(3) As Integer

   For I = 1 To 3

      a(I) = Mid(CStr(n), I, 1)

   Next

   If a(1) < a(2) And a(2) < a(3) Then

      st = "=>升序数"

   ElseIf a(1) > a(2) And a(2) > a(3) Then

      st = "=>降序数"

   Else

      st = "=>"

   End If

End Function

 

Private Sub Command2_Click()

Text1.Text = ""

List1.Clear

End Sub

 

Private Sub Command3_Click()

End

End Sub