第二道难题！

Question

题目如下：用户随便输入两个值，分别是A和B，请你在空格内依次填入数字1-9(就是输出数字)，使两道等式成立。如果用户输入的两个值根本不能够成以下等式，就提示用户(MsgBox "不能构成等式")！
□□×□□×□=A
□□×□×□=B

Answer 1

楼主的意思是啥？没太明白…………是不是输入一个五位数Ａ、一个四位数Ｂ。
假设Ａ的十进制数是：abcde
　　Ｂ的十进制数是：mnpq验证是否满足：
 ab * cd * e = Ａ
 mn * p * q = Ｂ如果是这样的话，你可以写个代码来枚举一下。
结论是：没有符合要求的数据！

Answer 2

Private Sub Command1_Click()
Dim s
s = InputBox("请输入一个整数：", "数据输入")
If s <> "" Then
Text2 = s
End If
End Sub
Private Sub Form_Load()
Command1.Caption = "开始"
For i = 0 To Text1.Count - 1
Text1(i).Appearance = 0
Text1(i).Text = ""
Text1(i).BackColor = Form1.BackColor
Next
Label1.BackColor = Form1.BackColor
Label2.BackColor = Form1.BackColor
Label3.BackColor = Form1.BackColor
Label1.Caption = "×"
Label2.Caption = "×"
Label3.Caption = "="
Text2.Text = ""
End SubPrivate Sub Text1_Change(Index As Integer)
If Text2.Text = "" Then MsgBox "请先输入点击开始按钮输入数据！": Exit Sub
If Val(Text1(Index)) < 0 Or Val(Text1(Index)) > 9 Then
MsgBox "只能输入0——9"
End If
End SubPrivate Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
If (Val(Text1(0)) * 10 + Val(Text1(1))) * (Val(Text1(2)) * 10 + Val(Text1(3))) * Val(Text1(4)) = Val(Text2) Then
MsgBox "正确！"
Else
MsgBox "不正确！"
End If
End If
End Sub

Answer 3

时间较长（10秒以上），没找到快的算法。
Option ExplicitDim iStr(), ii As LongPrivate Sub Command1_Click()
''□□×□□×□=A
''□□×□×□=B
    
    Dim a(), b, c, i, j, t
    Dim ss(2), s(2), ff As Boolean
    t = Timer
    b = "123456789"
    c = Len(b) - 1
    ReDim a(c)
    For i = 0 To c
        a(i) = Mid(b, i + 1, 1)
    Next
    pai a, 0, c + 1
    For i = 0 To UBound(iStr)
        For j = 1 To 3
            ss(j - 1) = Mid(iStr(i), 2 * j - 1, 2)
            s(j - 1) = Mid(iStr(i), j + 6, 1)
        Next
        If ss(0) * ss(1) * s(0) = 2856 And ss(2) * s(1) * s(2) = 4032 Then
           Debug.Print ss(0), ss(1), s(0), ss(2), s(1), s(2)
           ff = True
           'Exit For
        End If
    Next
    Debug.Print Timer - t
    If Not ff Then MsgBox "No"
    
End SubSub chang(a(), m As Integer)
   Dim i As Integer, j As Integer
   Dim temp As String
   temp = a(0)
   For i = 0 To m - 1
       a(i) = a(i + 1)
   Next
   a(i) = temp
End SubSub pai(a(), m As Integer, n As Integer)
    Dim k As Integer
    If m < n Then
       For k = 0 To m
           pai a, m + 1, n
           chang a, m
       Next
    Else
       ReDim Preserve iStr(ii)
       iStr(ii) = Join(a, "")
       ii = ii + 1
       DoEvents
    End If
   
End Sub

Answer 4

也许不是最好的。但是可以“瞬间”给出结果。
自己参考再修改一下吧：
Option ExplicitPrivate Sub Command1_Click()
'测试第一种情况
    Me.Cls
    Call getNumberA(3570)
End SubPrivate Sub Command2_Click()
'测试第二种情况
    Me.Cls
    Call getNumberB(928)
'    Call getNumberB(900)
End SubPrivate Sub getNumberA(ByVal num As Long)
' 枚举第一种情况
    Dim i&, j&, m&, n&
    For i = 1 To 9
        If (num Mod i = 0) Then
            m = num \ i
            n = Int(Sqr(m))
            If (n > 99) Then n = 99
            For j = 10 To n
                If (m Mod j = 0) Then
                    Do
                        n = m \ j:   If (n > 99) Then Exit Do
                        If (chkNum(n * 1000 + j * 10 + i)) Then Exit Do
                        Print n; j; i
                        ' Exit Sub '只列出一个结果
                        Exit Do
                    Loop
                End If
            Next
        End If
    Next
End SubPrivate Sub getNumberB(ByVal num As Long)
' 枚举第二种情况
    Dim i&, j&, m&, n&
    For i = 1 To 9
        If (num Mod i = 0) Then
            m = num \ i
            n = Int(Sqr(m))
            For j = i + 1 To 9
                If (m Mod j = 0) Then
                    Do
                        n = m \ j:   If (n > 99) Then Exit Do
                        If (chkNum(n * 100 + j * 10 + i)) Then Exit Do
                        Print n; j; i
                        ' Exit Sub '只列出一个结果
                        Exit Do
                    Loop
                End If
            Next
        End If
    Next
End SubPrivate Function chkNum(ByVal v&) As Boolean
    Dim t&, s&
    chkNum = True
    While (v > 0)
        t = v Mod 10
        v = v \ 10
        s = v
        While (s > 0)
            If ((s Mod 10) = t) Then Exit Function
            s = s \ 10
        Wend
    Wend
    chkNum = False
End Function闪人…………睡觉去了…………

Answer 5

如果结果就是3个部分，而且返回任意一个，试试下面这个对不对：
Option ExplicitPrivate Sub GetCounter(ByVal pNum As Long, ByVal pPlace As Long, pStart As Long, pEnd As Long)
    'pPlace 传入几位数
    'pStart 返回循环起始值（对应几位数的最小值），比如2位数就是10
    'pEnd 返回循环终止值（对应几位数的最大值），比如2位数就是99
    Dim arrPlace
    
    arrPlace = Array(1, 10, 100, 1000)   '这儿定义最大4位数的数字，自己的扩展
    pStart = arrPlace(pPlace - 1)
    pEnd = pStart * 10 - 1
    If pNum < pEnd Then pEnd = pNum
    
End Sub
Function GetExpressions(ByVal pNum As Long, m As Long, n As Long, l As Long) As Boolean
    'pNum 用户输入的数字
    'm,n,l 传入3个部分各是几位数，并返回结果
    
    Dim arrPlace
    Dim Length As Long
    Dim lngStart As Long, lngEnd As Long
    Dim i As Long, j As Long
    Dim tmp As Long
    
    Call GetCounter(pNum, m, lngStart, lngEnd)
    For i = lngStart To lngEnd
        tmp = pNum
        If (tmp Mod i) = 0 Then
            tmp = tmp \ i
            Call GetCounter(tmp, n, lngStart, lngEnd)
            For j = lngStart To lngEnd
                If (tmp Mod j) = 0 Then
                    If Len(CStr(j)) = n And Len(CStr(tmp \ j)) = l Then
                        m = i
                        n = j
                        l = tmp \ j
                        GetExpressions = True
                        Exit Function
                    End If
                End If
            Next j
        End If
    Next i
    
End FunctionPrivate Sub Command1_Click()
    Dim Num As Long
    Dim x As Long, y As Long, z As Long
    
    '□□×□□×□=A
    x = 2   '结果中第1个是2位数
    y = 2   '结果中第2个是2位数
    z = 1   '结果中第3个是1位数
    Num = 3570
    If GetExpressions(Num, x, y, z) Then
        Debug.Print x; y; z
    Else
        Debug.Print "没有结果"
    End If
    
    '□□×□×□=B
    x = 2
    y = 1
    z = 1
    Num = 928
    If GetExpressions(Num, x, y, z) Then
        Debug.Print x; y; z
    Else
        Debug.Print "没有结果"
    End If
    
    '□□□×□×□□=C
    x = 3
    y = 1
    z = 2
    Num = 92840
    If GetExpressions(Num, x, y, z) Then
        Debug.Print x; y; z
    Else
        Debug.Print "没有结果"
    End If
    
End Sub如果要写成通用的，并穷尽结果的，只有结合组合来做，写的话比较累人，没时间....