24 点问题 - VB6论坛

楼主

已结贴√ 问题点数：1 回复次数：17

24 点问题

在想，如何列出 24 点的所有答案，或者说给 4个数，然后给出是否组合成 24 点。想啊想，就想到先把表达式列出来，然后再测试。代码如下：

程序代码：

Option Explicit

'工程需要引用microsoft script control

Dim rs As String                '所有的表达式

Private Sub Command1_Click()
'列出所有的可能
Dim a As Long, b As Long, c As Long, d As Long
Dim s As String
Dim FJ() As String


Open App.Path & "\24点.txt" For Output As #1

For a = 1 To 10
For b = 1 To 10
For c = 1 To 10
For d = 1 To 10

    s = Test24(a, b, c, d)          '测试去
    If Len(s) > 0 Then
        Print #1, s;                '有结果就写入，因为结果是带回车的，所以不能再写入回车了
    End If
    
Next d
Next c
Next b
Next a

Close #1
MsgBox "计算完成！请检查 24点.txt 文件。", vbInformation

End Sub

Private Sub Command2_Click()
'测试4个数
Dim s2 As String
Dim a As Long, b As Long, c As Long, d As Long

'先读数
a = Val(IntTXT(0))
b = Val(IntTXT(1))
c = Val(IntTXT(2))
d = Val(IntTXT(3))

'判断范围
If a < 0 Or a > 10 Then Exit Sub
If b < 0 Or b > 10 Then Exit Sub
If c < 0 Or c > 10 Then Exit Sub
If d < 0 Or d > 10 Then Exit Sub

Text1.Text = "运算中..."
DoEvents
    
'按排列组合去测试
s2 = s2 & Test24(a, b, c, d)
s2 = s2 & Test24(a, b, d, c)
s2 = s2 & Test24(a, c, b, d)
s2 = s2 & Test24(a, c, d, b)
s2 = s2 & Test24(a, d, b, c)
s2 = s2 & Test24(a, d, c, b)

s2 = s2 & Test24(b, a, c, d)
s2 = s2 & Test24(b, a, d, c)
s2 = s2 & Test24(b, c, d, a)
s2 = s2 & Test24(b, c, a, d)
s2 = s2 & Test24(b, d, a, c)
s2 = s2 & Test24(b, d, c, a)

s2 = s2 & Test24(c, b, a, d)
s2 = s2 & Test24(c, b, d, a)
s2 = s2 & Test24(c, a, b, d)
s2 = s2 & Test24(c, a, d, b)
s2 = s2 & Test24(c, d, b, a)
s2 = s2 & Test24(c, d, a, b)

s2 = s2 & Test24(d, b, c, a)
s2 = s2 & Test24(d, b, a, c)
s2 = s2 & Test24(d, c, b, a)
s2 = s2 & Test24(d, c, a, b)
s2 = s2 & Test24(d, a, b, c)
s2 = s2 & Test24(d, a, c, b)

'检查测试结果
If Len(s2) > 0 Then
    Text1.Text = s2
Else
    Text1.Text = "无解！"
End If

End Sub

Private Sub Form_Load()

    Open App.Path & "\表达式.txt" For Binary As #1
        rs = StrConv(InputB$(LOF(1), #1), vbUnicode)
    Close #1
    
End Sub

Public Function Test24(a As Long, b As Long, c As Long, d As Long) As String

Dim s As String
Dim o As Long
Dim m As Long
Dim s2 As String
Dim FJ() As String

Dim ScriptControl1 As New scriptcontrol
ScriptControl1.Language = "VBScript"

s = rs                          '所有的表达式
s = Replace(s, "a", a)          '把数字填进去
s = Replace(s, "b", b)
s = Replace(s, "c", c)
s = Replace(s, "d", d)

FJ = Split(s, vbCrLf)           '分解成一个一个的表达式
For o = 0 To UBound(FJ)
    If Len(FJ(o)) > 0 Then      '是有效表达式
        m = ScriptControl1.Eval(FJ(o))      '运算
        If m = 24 Then                      '结果是24吗
            s2 = s2 & FJ(o) & " = 24" & vbCrLf
        End If
    End If
Next o

Test24 = s2                     '返回结果

End Function

搜索更多相关主题的帖子: 表达式　如何　

第 2 楼

得分:0

我想出来的表达式有：

程序代码：

a + b + c + d 
a + b + c - d 

a * b + c + d 
a * b * c + d 

a * b + c - d 
a * b * c - d 

a * b - c - d 

(a + b) * c + d
(a + b) * c - d
(a + b) * (c + d)
(a + b) * (c - d)

(a - b) * c + d
(a - b) * c - d
(a - b) * (c + d)
(a - b) * (c - d)

(a + b) * c * d
(a + b) * c / d

(a - b) * c * d
(a - b) * c / d

保存为txt文件，放到工程一起。

授人于鱼，不如授人于渔
早已停用QQ了

第 3 楼

得分:0

我也就是想过这个问题，所以把算法的排列写到文本里面去。
修改TEST24函数，以便支持注释

程序代码：

Public Function Test24(a As Long, b As Long, c As Long, d As Long) As String
On Error Resume Next

Dim s As String
Dim o As Long
Dim m As Long
Dim s2 As String
Dim FJ() As String

Dim ScriptControl1 As New ScriptControl
ScriptControl1.Language = "VBScript"

s = rs                          '所有的表达式
s = Replace(s, "a", a)          '把数字填进去
s = Replace(s, "b", b)
s = Replace(s, "c", c)
s = Replace(s, "d", d)

FJ = Split(s, vbCrLf)           '分解成一个一个的表达式
For o = 0 To UBound(FJ)
    If Len(FJ(o)) > 0 Then    '是有效表达式
        If Left(FJ(o), 1) <> ";" Then           '非注释
            m = ScriptControl1.Eval(FJ(o))      '运算
            If m = 24 Then                      '结果是24吗
                s2 = s2 & FJ(o) & " = 24" & vbCrLf
            End If
        End If
    End If
Next o

Test24 = s2                     '返回结果

End Function

按照你说的，我重新排列过了表达式：

(a + b) + (c + d)
(a + b) + (c - d)
(a + b) + (c * d)
(a + b) + (c / d)

(a - b) + (c + d)
(a - b) + (c - d)
(a - b) + (c * d)
(a - b) + (c / d)

(a * b) + (c + d)
(a * b) + (c - d)
(a * b) + (c * d)
(a * b) + (c / d)

(a / b) + (c + d)
(a / b) + (c - d)
(a / b) + (c * d)
(a / b) + (c / d)

(a + b) - (c + d)
(a + b) - (c - d)
(a + b) - (c * d)
(a + b) - (c / d)

(a - b) - (c + d)
(a - b) - (c - d)
(a - b) - (c * d)
(a - b) - (c / d)

(a * b) - (c + d)
(a * b) - (c - d)
(a * b) - (c * d)
(a * b) - (c / d)

(a / b) - (c + d)
(a / b) - (c - d)
(a / b) - (c * d)
(a / b) - (c / d)

(a + b) * (c + d)
(a + b) * (c - d)
(a + b) * (c * d)
(a + b) * (c / d)

(a - b) * (c + d)
(a - b) * (c - d)
(a - b) * (c * d)
(a - b) * (c / d)

(a * b) * (c + d)
(a * b) * (c - d)
(a * b) * (c * d)
(a * b) * (c / d)

(a / b) * (c + d)
(a / b) * (c - d)
(a / b) * (c * d)
(a / b) * (c / d)

(a + b) / (c + d)
(a + b) / (c - d)
(a + b) / (c * d)
(a + b) / (c / d)

(a - b) / (c + d)
(a - b) / (c - d)
(a - b) / (c * d)
(a - b) / (c / d)

(a * b) / (c + d)
(a * b) / (c - d)
(a * b) / (c * d)
(a * b) / (c / d)

(a / b) / (c + d)
(a / b) / (c - d)
(a / b) / (c * d)
(a / b) / (c / d)

((a + b) + c) + d
((a + b) + c) - d
((a + b) + c) * d
((a + b) + c) / d

((a - b) + c) + d
((a - b) + c) - d
((a - b) + c) * d
((a - b) + c) / d

((a * b) + c) + d
((a * b) + c) - d
((a * b) + c) * d
((a * b) + c) / d

((a / b) + c) + d
((a / b) + c) - d
((a / b) + c) * d
((a / b) + c) / d

((a + b) - c) + d
((a + b) - c) - d
((a + b) - c) * d
((a + b) - c) / d

((a - b) - c) + d
((a - b) - c) - d
((a - b) - c) * d
((a - b) - c) / d

((a * b) - c) + d
((a * b) - c) - d
((a * b) - c) * d
((a * b) - c) / d

((a / b) - c) + d
((a / b) - c) - d
((a / b) - c) * d
((a / b) - c) / d

((a + b) * c) + d
((a + b) * c) - d
((a + b) * c) * d
((a + b) * c) / d

((a - b) * c) + d
((a - b) * c) - d
((a - b) * c) * d
((a - b) * c) / d

((a * b) * c) + d
((a * b) * c) - d
((a * b) * c) * d
((a * b) * c) / d

((a / b) * c) + d
((a / b) * c) - d
((a / b) * c) * d
((a / b) * c) / d

((a + b) / c) + d
((a + b) / c) - d
((a + b) / c) * d
((a + b) / c) / d

((a - b) / c) + d
((a - b) / c) - d
((a - b) / c) * d
((a - b) / c) / d

((a * b) / c) + d
((a * b) / c) - d
((a * b) / c) * d
((a * b) / c) / d

((a / b) / c) + d
((a / b) / c) - d
((a / b) / c) * d
((a / b) / c) / d

仔细考虑一下，还是使用这种写好了的表达式来检索好写程序。如果把这些算法写到程序里，会好烦好烦，太多分支了。
如果是发布的工程，可以使用资源编辑器，写到程序内部去。

[ 本帖最后由风吹过b 于 2015-6-15 11:57 编辑 ]

授人于鱼，不如授人于渔
早已停用QQ了

第 4 楼

得分:0

还有如：
a+(b+c)+d
a+(b+c)-d
a+(b+c)*d
a+(b+c)/d

可以转化为
(b+c)+d+a
(b+c)-d+a
(b+c)*d+a
(b+c)/d+a

因为程序里会把 abcd 互换位置，所以这种的排列就没有意义了。

授人于鱼，不如授人于渔
早已停用QQ了

第 5 楼

得分:0

按我最后排列的表达式来穷举的。

如果是输入的4个数。
范围判断在这：
'先读数
a = Val(IntTXT(0))
b = Val(IntTXT(1))
c = Val(IntTXT(2))
d = Val(IntTXT(3))

'判断范围
If a < 0 Or a > 10 Then Exit Sub
If b < 0 Or b > 10 Then Exit Sub
If c < 0 Or c > 10 Then Exit Sub
If d < 0 Or d > 10 Then Exit Sub

这4个数，按 24种排列，代入这些表达式求值。
'按排列组合去测试
s2 = s2 & Test24(a, b, c, d)
s2 = s2 & Test24(a, b, d, c)
s2 = s2 & Test24(a, c, b, d)
s2 = s2 & Test24(a, c, d, b)
s2 = s2 & Test24(a, d, b, c)
s2 = s2 & Test24(a, d, c, b)

s2 = s2 & Test24(b, a, c, d)
s2 = s2 & Test24(b, a, d, c)
s2 = s2 & Test24(b, c, d, a)
s2 = s2 & Test24(b, c, a, d)
s2 = s2 & Test24(b, d, a, c)
s2 = s2 & Test24(b, d, c, a)

s2 = s2 & Test24(c, b, a, d)
s2 = s2 & Test24(c, b, d, a)
s2 = s2 & Test24(c, a, b, d)
s2 = s2 & Test24(c, a, d, b)
s2 = s2 & Test24(c, d, b, a)
s2 = s2 & Test24(c, d, a, b)

s2 = s2 & Test24(d, b, c, a)
s2 = s2 & Test24(d, b, a, c)
s2 = s2 & Test24(d, c, b, a)
s2 = s2 & Test24(d, c, a, b)
s2 = s2 & Test24(d, a, b, c)
s2 = s2 & Test24(d, a, c, b)

如果是测试所有的结果：
那就不区分 24种组合了，因为四层循环，就会使所有的可能都会去测试。
For a = 1 To 10
For b = 1 To 10
For c = 1 To 10
For d = 1 To 10

授人于鱼，不如授人于渔
早已停用QQ了

第 6 楼

得分:0

回复 8楼边小白

24点的规则是：

4个 1-10 的数字，可以重复。使用四则运算符，可以使用括号，计算出 24 来。

临时去掉数据范围得出来的结果，里面有因为取整造成错误的情况，看来要修正程序。
((7 / 12) * 10) + 18 = 24
((7 * 10) / 12) + 18 = 24
(7 + 18) - (12 / 10) = 24
(7 + 18) - (10 / 12) = 24
((10 * 7) / 12) + 18 = 24
((10 / 12) * 7) + 18 = 24
((10 * 18) - 12) / 7 = 24
(18 + 7) - (10 / 12) = 24
(18 + 7) - (12 / 10) = 24
((18 * 10) - 12) / 7 = 24

修正的结果为浮点数，得到了是：
((18 * 10) - 12) / 7 = 24
((10 * 18) - 12) / 7 = 24

[ 本帖最后由风吹过b 于 2015-6-15 17:28 编辑 ]

授人于鱼，不如授人于渔
早已停用QQ了

第 7 楼

得分:0

不考虑交换，按二种情况写过了，现在写成了模块。代码如下：

Option Explicit

Public Type T24type
    s As String
    v As Long
End Type

Public Function Test24_2(a As Long, b As Long, c As Long, d As Long) As String

Dim r1(4) As T24type, r2(4) As T24type, r3(4) As T24type
Dim l1 As T24type, l2 As T24type
Dim l3 As T24type, l4 As T24type
Dim i As Long, j As Long, m As Long
Dim s As String

'第一个数
l1.s = CStr(a)
l1.v = a
'第二个数
l2.s = CStr(b)
l2.v = b
'第三个数
l3.s = CStr(c)
l3.v = c
'第四个数
l4.s = CStr(d)
l4.v = d

'第一个数与第二个数计算
Call operation(l1, l2, r1)

'第一分支，第1、2数运算后与第3、4数运算

'第三个数与第四个数计算
Call operation(l3, l4, r2)
For i = 1 To 4
    For j = 1 To 4
        If r1(i).v >= 0 And r2(i).v >= 0 Then
            Call operation(r1(j), r2(i), r3)
            For m = 1 To 4
                If r3(m).v = 24 Then
                    s = s & r3(m).s & " = 24" & vbCrLf
                End If
            Next m
        End If
    Next j
Next i

'第二分支，第1、2数运算后与第3数运算,再与第4数运算
For i = 1 To 4
    If r1(i).v >= 0 Then
        Call operation(r1(i), l3, r2)
        For j = 1 To 4
            If r2(j).v >= 0 Then
                Call operation(r2(j), l4, r3)
                For m = 1 To 4
                    If r3(m).v = 24 Then
                        s = s & r3(m).s & " = 24" & vbCrLf
                    End If
                Next m
            End If
        Next j
    End If
Next i

Test24_2 = s

End Function

Public Sub operation(a As T24type, b As T24type, r() As T24type)

Dim t As Single

'加法
r(1).v = a.v + b.v
r(1).s = "( " & a.s & " + " & b.s & " )"

'减法，不考虑负数
If a.v > b.v Then
    r(2).v = a.v - b.v
    r(2).s = "( " & a.s & " - " & b.s & " )"
Else
    r(2).v = -1
End If

'乘法
r(3).v = a.v * b.v
r(3).s = "( " & a.s & " * " & b.s & " )"

'除法，只允许整除
If a.v >= b.v And b.v > 0 Then
    If a.v Mod b.v = 0 Then
        r(4).v = a.v / b.v
        r(4).s = "( " & a.s & " / " & b.s & " )"
    Else
        r(4).v = -1
    End If

Else
    r(4).v = -1
End If

End Sub

如输入 1 2 3 4
结果为：

( ( 1 * 2 ) * ( 3 * 4 ) ) = 24
( ( ( 1 + 2 ) + 3 ) * 4 ) = 24
( ( ( 1 * 2 ) * 3 ) * 4 ) = 24
( ( 1 * 2 ) * ( 4 * 3 ) ) = 24
( ( ( 1 * 2 ) * 4 ) * 3 ) = 24
( ( 1 + 3 ) * ( 2 + 4 ) ) = 24
( ( 1 * 3 ) * ( 2 * 4 ) ) = 24
( ( ( 1 + 3 ) + 2 ) * 4 ) = 24
( ( ( 1 * 3 ) * 2 ) * 4 ) = 24
( ( 1 + 3 ) * ( 4 + 2 ) ) = 24
( ( 1 * 3 ) * ( 4 * 2 ) ) = 24
( ( ( 1 * 3 ) * 4 ) * 2 ) = 24
( ( 1 * 4 ) * ( 2 * 3 ) ) = 24
( ( ( 1 * 4 ) * 2 ) * 3 ) = 24
( ( 1 * 4 ) * ( 3 * 2 ) ) = 24
( ( ( 1 * 4 ) * 3 ) * 2 ) = 24
( ( 2 * 1 ) * ( 3 * 4 ) ) = 24
( ( 2 / 1 ) * ( 3 * 4 ) ) = 24
( ( ( 2 + 1 ) + 3 ) * 4 ) = 24
( ( ( 2 * 1 ) * 3 ) * 4 ) = 24
( ( ( 2 / 1 ) * 3 ) * 4 ) = 24
( ( 2 * 1 ) * ( 4 * 3 ) ) = 24
( ( 2 / 1 ) * ( 4 * 3 ) ) = 24
( ( ( 2 * 1 ) * 4 ) * 3 ) = 24
( ( ( 2 / 1 ) * 4 ) * 3 ) = 24
( ( 2 * 3 ) * ( 4 * 1 ) ) = 24
( ( ( 2 * 3 ) * 4 ) * 1 ) = 24
( ( ( 2 * 3 ) * 4 ) / 1 ) = 24
( ( 2 * 3 ) * ( 1 * 4 ) ) = 24
( ( ( 2 + 3 ) + 1 ) * 4 ) = 24
( ( ( 2 * 3 ) * 1 ) * 4 ) = 24
( ( ( 2 * 3 ) / 1 ) * 4 ) = 24
( ( 2 + 4 ) * ( 1 + 3 ) ) = 24
( ( 2 * 4 ) * ( 1 * 3 ) ) = 24
( ( ( 2 * 4 ) * 1 ) * 3 ) = 24
( ( ( 2 * 4 ) / 1 ) * 3 ) = 24
( ( 2 + 4 ) * ( 3 + 1 ) ) = 24
( ( 2 * 4 ) * ( 3 * 1 ) ) = 24
( ( ( 2 * 4 ) * 3 ) * 1 ) = 24
( ( ( 2 * 4 ) * 3 ) / 1 ) = 24
( ( 3 * 2 ) * ( 1 * 4 ) ) = 24
( ( ( 3 + 2 ) + 1 ) * 4 ) = 24
( ( ( 3 * 2 ) * 1 ) * 4 ) = 24
( ( ( 3 * 2 ) / 1 ) * 4 ) = 24
( ( 3 * 2 ) * ( 4 * 1 ) ) = 24
( ( ( 3 * 2 ) * 4 ) * 1 ) = 24
( ( ( 3 * 2 ) * 4 ) / 1 ) = 24
( ( 3 + 1 ) * ( 2 + 4 ) ) = 24
( ( 3 * 1 ) * ( 2 * 4 ) ) = 24
( ( 3 / 1 ) * ( 2 * 4 ) ) = 24
( ( ( 3 + 1 ) + 2 ) * 4 ) = 24
( ( ( 3 * 1 ) * 2 ) * 4 ) = 24
( ( ( 3 / 1 ) * 2 ) * 4 ) = 24
( ( 3 + 1 ) * ( 4 + 2 ) ) = 24
( ( 3 * 1 ) * ( 4 * 2 ) ) = 24
( ( 3 / 1 ) * ( 4 * 2 ) ) = 24
( ( ( 3 * 1 ) * 4 ) * 2 ) = 24
( ( ( 3 / 1 ) * 4 ) * 2 ) = 24
( ( 3 * 4 ) * ( 2 * 1 ) ) = 24
( ( ( 3 * 4 ) * 2 ) * 1 ) = 24
( ( ( 3 * 4 ) * 2 ) / 1 ) = 24
( ( 3 * 4 ) * ( 1 * 2 ) ) = 24
( ( ( 3 * 4 ) * 1 ) * 2 ) = 24
( ( ( 3 * 4 ) / 1 ) * 2 ) = 24
( ( 4 + 2 ) * ( 3 + 1 ) ) = 24
( ( 4 * 2 ) * ( 3 * 1 ) ) = 24
( ( 4 * 2 ) * ( 3 / 1 ) ) = 24
( ( ( 4 * 2 ) * 3 ) * 1 ) = 24
( ( ( 4 * 2 ) * 3 ) / 1 ) = 24
( ( 4 + 2 ) * ( 1 + 3 ) ) = 24
( ( 4 * 2 ) * ( 1 * 3 ) ) = 24
( ( ( 4 * 2 ) * 1 ) * 3 ) = 24
( ( ( 4 * 2 ) / 1 ) * 3 ) = 24
( ( 4 * 3 ) * ( 2 * 1 ) ) = 24
( ( ( 4 * 3 ) * 2 ) * 1 ) = 24
( ( ( 4 * 3 ) * 2 ) / 1 ) = 24
( ( 4 * 3 ) * ( 1 * 2 ) ) = 24
( ( ( 4 * 3 ) * 1 ) * 2 ) = 24
( ( ( 4 * 3 ) / 1 ) * 2 ) = 24
( ( 4 * 1 ) * ( 2 * 3 ) ) = 24
( ( 4 / 1 ) * ( 2 * 3 ) ) = 24
( ( ( 4 * 1 ) * 2 ) * 3 ) = 24
( ( ( 4 / 1 ) * 2 ) * 3 ) = 24
( ( 4 * 1 ) * ( 3 * 2 ) ) = 24
( ( 4 / 1 ) * ( 3 * 2 ) ) = 24
( ( ( 4 * 1 ) * 3 ) * 2 ) = 24
( ( ( 4 / 1 ) * 3 ) * 2 ) = 24

授人于鱼，不如授人于渔
早已停用QQ了

第 8 楼

得分:0

手工对比了一下，使用表达式时，运算过程中出现负数。而使用算法时，可以把负数丢弃。
如果出现负数时，后面有交换过结果来运算的情况，也不需要，答案更适合小学生看了。
运算速度，算法快很多很多。不错。

为什么我不考虑交换呢。是因为我调用时，会把这4个数重新排列组合 24 种进行调用，所以不需要考虑交换的问题。
为什么这么多的括号，是为了排版的表示运算的先后。

增加去重功能。先要把多余的括号干掉，然后再来去重。其中，如果是加法的话，去括号就很烦，需要修改运算函数的组合算法。

'去掉括号之间的空格
s = Replace(s, "( (", "((")
'去多余的空格
Do
    i = Len(s)
    s = Replace(s, "  ", " ")
Loop While Len(s) <> i

'去重
Dim fj() As String
'分行
fj = Split(s, vbCrLf)

'扫描
For i = 1 To UBound(fj)
    For j = i + 1 To UBound(fj)
        If fj(i) = fj(j) Then       '扫描到后面有相同的
            fj(j) = ""              '后面的清空
        End If
    Next j
Next i
'重新组合，不能使用 join 函数是因为有空行在
s = ""
For i = 1 To UBound(fj)
    If Len(fj(i)) > 0 Then
        s = s & fj(i) & vbCrLf
    End If
Next i

r(3).s = "  " & a.s & " * " & b.s & "  "

        r(4).s = "  " & a.s & " / " & b.s & "  "

授人于鱼，不如授人于渔
早已停用QQ了

第 9 楼

得分:0

我明确要排除计算过程中的非整数。

(5-(1/5))*5
这里面：1/5 ，得到的小数，我计算过程中就会丢弃。

你说这种情况，先计算 2和3，然后再结合 1 ，再结合 4 ，
如果是1@(2?3) 1和2、3做减法，除法，我前面是没有涉及到。这点是我考虑不周。

按我前面的调用方法，我确实不需要考虑交换
如：（假设不丢弃非整数）
5 5 1 5 ,你可以得出 (5-(1/5))*5 这种情况，我得不出。
但我后面调用里，有 5 1 5 5 这个调用，，如果补充算法后，我就得出这个式子了。

授人于鱼，不如授人于渔
早已停用QQ了

第 10 楼

得分:0

调用代码在这。在调用代码里组合的。

'测试4个数
Dim s2 As String
Dim a As Long, b As Long, c As Long, d As Long

'先读数
a = Val(IntTXT(0))
b = Val(IntTXT(1))
c = Val(IntTXT(2))
d = Val(IntTXT(3))

'判断范围
If a < 0 Or a > 10 Then Exit Sub
If b < 0 Or b > 10 Then Exit Sub
If c < 0 Or c > 10 Then Exit Sub
If d < 0 Or d > 10 Then Exit Sub

Text1.Text = "运算中..."
DoEvents

'按排列组合去测试
s2 = s2 & Test24_2(a, b, c, d)
s2 = s2 & Test24_2(a, b, d, c)
s2 = s2 & Test24_2(a, c, b, d)
s2 = s2 & Test24_2(a, c, d, b)
s2 = s2 & Test24_2(a, d, b, c)
s2 = s2 & Test24_2(a, d, c, b)

s2 = s2 & Test24_2(b, a, c, d)
s2 = s2 & Test24_2(b, a, d, c)
s2 = s2 & Test24_2(b, c, d, a)
s2 = s2 & Test24_2(b, c, a, d)
s2 = s2 & Test24_2(b, d, a, c)
s2 = s2 & Test24_2(b, d, c, a)

s2 = s2 & Test24_2(c, b, a, d)
s2 = s2 & Test24_2(c, b, d, a)
s2 = s2 & Test24_2(c, a, b, d)
s2 = s2 & Test24_2(c, a, d, b)
s2 = s2 & Test24_2(c, d, b, a)
s2 = s2 & Test24_2(c, d, a, b)

s2 = s2 & Test24_2(d, b, c, a)
s2 = s2 & Test24_2(d, b, a, c)
s2 = s2 & Test24_2(d, c, b, a)
s2 = s2 & Test24_2(d, c, a, b)
s2 = s2 & Test24_2(d, a, b, c)
s2 = s2 & Test24_2(d, a, c, b)

'检查测试结果
If Len(s2) > 0 Then
    Text1.Text = s2
Else
    Text1.Text = "无解！"
End If

授人于鱼，不如授人于渔
早已停用QQ了