? 救命啊！我急需一位高手中的高手为我解决这个问题啊！！！！事关重大！！

Question

先贴一个猜数字的，现编的
Private Sub form_Click()
Dim a(3), b(3), i, j, k, tmp, tmp1 As String, p As Boolean, A1, B1
Randomize
For i = 0 To 3
    a(i) = Int(Rnd * 10)
    For k = 0 To i - 1
        If a(i) = a(k) Then i = i - 1
    Next k
    Debug.Print a(i),
Next i
For i = 1 To 8
    tmp = InputBox("请输入四位不同的数字(0-9)" & vbNewLine & "输入为空或取消则中止运行。", "这是第" & i & "次猜题")
    If tmp = "" Then Exit Sub
    p = False
    If Len(Trim(tmp)) = 4 Then
        For j = 1 To 4
            tmp1 = Mid(tmp, j, 1)
            If tmp1 >= "0" And tmp1 <= "9" Then
                b(j - 1) = Val(tmp1)
                For k = 1 To j - 1
                    If b(j - 1) = b(k - 1) Then
                        p = True
                        Exit For
                    End If
                Next k
            Else
                p = True: Exit For
            End If
        Next j
    Else
        p = True
    End If
    If p Then
        MsgBox "输入数据相同或非法！请再试一次！", , "猜数字"
        i = i - 1
    Else
        A1 = 0: B1 = 0
        For k = 0 To 3
            If a(k) = b(k) Then
                A1 = A1 + 1
            Else
                For j = 0 To 3
                    If a(k) = b(j) Then B1 = B1 + 1
                Next j
            End If
        Next k
        Print i, tmp, A1 & "A" & B1 & "B"
        If A1 = 4 Then
            MsgBox tmp & "恭喜你!你猜得完全正确!", , "猜数字"
            Exit Sub
        End If
    End If
Next i
End Sub

Answer 1

把代码复制成txt文件然后重新命名为frm文件VERSION 5.00 
Begin VB.Form Form1  
   Caption         =   "Form1" 
   ClientHeight    =   3195 
   ClientLeft      =   60 
   ClientTop       =   345 
   ClientWidth     =   4680 
   LinkTopic       =   "Form1" 
   ScaleHeight     =   3195 
   ScaleWidth      =   4680 
   StartUpPosition =   3  '窗口缺省 
   Begin VB.CommandButton CmdRe  
      Caption         =   "初始化" 
      Height          =   375 
      Left            =   2760 
      TabIndex        =   8 
      Top             =   2040 
      Width           =   735 
   End 
   Begin VB.CommandButton CmdAuto  
      Caption         =   "自动" 
      Height          =   375 
      Left            =   2400 
      TabIndex        =   7 
      Top             =   2640 
      Width           =   735 
   End 
   Begin VB.CommandButton CmdOk  
      Caption         =   "开始" 
      Enabled         =   0   'False 
      Height          =   375 
      Left            =   3480 
      TabIndex        =   5 
      Top             =   2640 
      Width           =   735 
   End 
   Begin VB.ListBox List1  
      Height          =   2040 
      Left            =   120 
      TabIndex        =   4 
      Top             =   120 
      Width           =   1575 
   End 
   Begin VB.TextBox Text1  
      Height          =   270 
      Index           =   3 
      Left            =   4080 
      MaxLength       =   1 
      TabIndex        =   3 
      Top             =   360 
      Width           =   495 
   End 
   Begin VB.TextBox Text1  
      Height          =   270 
      Index           =   2 
      Left            =   3440 
      MaxLength       =   1 
      TabIndex        =   2 
      Top             =   360 
      Width           =   495 
   End 
   Begin VB.TextBox Text1  
      Height          =   270 
      Index           =   1 
      Left            =   2800 
      MaxLength       =   1 
      TabIndex        =   1 
      Top             =   360 
      Width           =   495 
   End 
   Begin VB.TextBox Text1  
      Height          =   270 
      Index           =   0 
      Left            =   2160 
      MaxLength       =   1 
      TabIndex        =   0 
      Top             =   360 
      Width           =   495 
   End 
   Begin VB.Label Label1  
      Caption         =   "Label1" 
      Height          =   375 
      Left            =   240 
      TabIndex        =   6 
      Top             =   2640 
      Width           =   1695 
   End 
End 
Attribute VB_Name = "Form1" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 
Private Num(4) As Integer, IntNum(4) As Integer, Times As Integer, se As Collection, gb As Boolean Private Sub reset() 
    Randomize 
    Dim i As Integer, j As Integer, flag As Integer 
    For i = 1 To 4 
        Do 
            flag = 0 
            IntNum(i) = Rnd * 8 + 1 
            For j = 1 To i - 1 
                If IntNum(i) = IntNum(j) Then 
                    flag = 1 
                End If 
            Next j 
        Loop Until flag = 0 
    Next i 
    For i = 0 To 3 
        Text1(i).Enabled = True 
        Text1(i).Text = "" 
          
    Next i 
    Text1(0).SetFocus 
    List1.Clear 
    Times = 8 
    CmdOk.Enabled = True 
    Label1.Caption = "你还有" + Str(Times) + "次机会" 
    Form1.Caption = "猜数字" 
    CmdAuto.Enabled = True 
    gb = True 
End Sub Private Sub CmdAuto_Click() 
    Static sq As Integer, s3 As Integer, s2 As Integer, s1 As Integer 
    sq = IIf(gb, 0, sq) 
    Dim a, i 
    If sq = 0 Then 
        sq = 1 
        gb = False 
        Call zdrset 
        a = Int(Rnd * se.Count + 1) 
        s2 = se(a) 
        For i = 0 To 3 
            Text1(i).Text = Mid(Format(s2), i + 1) 
              
        Next i 
        Call SuanOK 
        s1 = Format(IntNum(1)) + Format(IntNum(2)) + Format(IntNum(3)) + Format(IntNum(4)) 
        s3 = zdong(s2, s1) 
    Else 
        s2 = zdong2(s2, s3) 
        Debug.Print s2; "*" 
        For i = 0 To 3 
            Text1(i).Text = Mid(Format(s2), i + 1) 
        Next i 
        Call SuanOK 
        s3 = zdong(s2, s1) 
    End If 
End Sub 
Private Sub CmdOk_Click() 
    Call SuanOK 
End Sub Private Sub CmdRe_Click() 
    Call reset 
End Sub Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer) 
    Dim K1 As Integer 
    If KeyAscii > 57 Or KeyAscii < 49 Then 
        KeyAscii = 0 
    Else 
        K1 = (Index + 1) Mod 4 
        Text1(K1).SetFocus 
          
        Text1(K1).SelStart = 0 
        Text1(K1).SelLength = 1 
    End If End Sub Public Sub SuanOK() 
    Dim i As Integer, j As Integer, flag As Integer, a As Integer, b As Integer 
    Dim s1 As String 
    For i = 1 To 4 
        Num(i) = Val(Text1(i - 1).Text) 
        s1 = s1 + Text1(i - 1).Text 
    Next i 
    For i = 1 To 4 
        For j = 1 To 4 
            If Num(i) = Num(j) And i <> j Then 
                flag = 1 
            End If 
        Next j 
    Next i 
    If flag = 0 Then 
        For i = 1 To 4 
            For j = 1 To 4 
                If Num(i) = IntNum(j) Then 
                    If i = j Then a = a + 1 Else b = b + 1 
                End If 
            Next j 
        Next i 
        s1 = s1 + ":" + Str(a) + "A" + Str(b) + "B" 
        List1.AddItem s1 
        Times = Times - 1 
        Label1.Caption = "你还有" + Str(Times) + "次机会" 
        Text1(0).SetFocus 
        If Times = 0 Or a = 4 Then 
            If a = 4 Then 
                Form1.Caption = "你过关了" 
            Else 
                Form1.Caption = "正确答案是" + Str(IntNum(1)) + Str(IntNum(2)) + Str(IntNum(3)) + Str(IntNum(4)) 
            End If 
            CmdOk.Enabled = False 
            CmdAuto.Enabled = False 
        End If 
    End If 
End Sub Public Function zdong(ByVal a As Integer, ByVal b As Integer) As Integer 
    Dim s(4) As Integer, s2(4) As Integer, i As Integer, j As Integer, t1 As Integer, t2 As Integer 
    For i = 4 To 1 Step -1 
        s(i) = a Mod 10 
        a = a \ 10 
    Next i 
    For i = 4 To 1 Step -1 
        s2(i) = b Mod 10 
        b = b \ 10 
    Next i 
     For i = 1 To 4 
            For j = 1 To 4 
                If s(i) = s2(j) Then 
                    If i = j Then t1 = t1 + 1 Else t2 = t2 + 1 
                End If 
            Next j 
    Next i 
    zdong = t1 * 10 + t2 
End Function Public Sub zdrset() 
    Dim i%, j%, i1%, j1%, s1% 
    Set se = New Collection 
    For i = 1 To 9 
        For j = 1 To 9 
            For i1 = 1 To 9 
                For j1 = 1 To 9 
                    If i <> j And j <> i1 And i1 <> j1 And j1 <> i And i <> i1 And j <> j1 Then 
                        s1 = i * 1000 + j * 100 + i1 * 10 + j1 
                        se.Add s1 
                    End If 
    Next j1, i1, j, i 
      
End Sub Public Function zdong2(j1 As Integer, j2 As Integer) As Integer 
    Randomize 
    Dim a, t, ker As Collection 
    Set ker = New Collection 
     
    For Each a In se 
    If zdong(j1, CInt(a)) <> j2 Then 
    Else 
    ker.Add a 
     
    End If 
    Next a 
     
    Set se = ker 
    a = Int(Rnd * se.Count + 1) 
    zdong2 = se(a) 
End Function