24点问题我写的完整代码
首先，感谢 lianyicq 的提醒和例子。再次，感谢 wmf2014 的测试。
开个百分散分贴，两位版主进来接分。
24点问题的规则：刚百度了一下，发现我前面搞错了范围。但以前在 计算器上玩的时候只有 一位数。
规则：给出4个数字,所给数字均为有整数(1至13之间),用加、减、乘、除(可加括号)把给出的数算成24,每个数必须用一次且只能用一次。
我们一般计算过程中，不能在计算过程出现小数、负数 ，只能出现自然数（包括 0 ）。
现在，平时，可以考虑几个人用扑克玩一会儿，特别陪着孩子玩，很开动脑筋的。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
窗体：控件：
Label ，四个，用于提示 输入4个值。当然，按 一次性输入 ，之间用空格输入也是可以了。
我标签的 Caption 分别是：&A= 、&B=、&C=、&D= ，可以用键盘 ALT+A、B、C、D 在这四个输入框中任何切换。
IntTxt ：TextBox ，控件数组，下标从 0 到 3，对应 四个值。
Command1：CommandButton，求解按钮， Caption：求解
Text1：TextBox，显示结果用，MultiLine =True（允许多行） ；ScrollBars =2（竖滚动条）
---------------窗体代码---------------------
程序代码：
Option Explicit
Private Sub Command1_Click()
'测试4个数
Dim s As String
Dim a(0 To 4) As Long
Dim i As Long, j As Long, k As Long, o As Long
For i = 0 To 3
If Not IsNumeric(IntTXT(i)) Then Exit Sub '输入的不是数字
a(i) = Val(IntTXT(i))
If a(i) < 0 Or a(i) > 13 Then Exit Sub
Next i
Text1.Text = "运算中..."
DoEvents
For i = 0 To 3
For j = 0 To 3
For k = 0 To 3
For o = 0 To 3
If j <> i And k <> j And k <> i And o <> i And o <> j And o <> k Then '之间全不相同，则去运算
s = s & Test24_2(a(i), a(j), a(k), a(o))
End If
Next o
Next k
Next j
Next i
'去掉括号之间的空格
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 = 0 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 = 0 To UBound(fj)
If Len(fj(i)) > 0 Then
s = s & fj(i) & vbCrLf
End If
Next i
'检查测试结果
If Len(s) > 0 Then
Text1.Text = s
Else
Text1.Text = "无解！"
End If
End Sub
Private Sub IntTXT_GotFocus(Index As Integer)
'获得焦点时选中所有的文本
With IntTXT(Index)
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
'全选和复制
If Shift = 2 Then '经测试，Ctrl =2
If KeyCode = vbKeyA Then
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
ElseIf KeyCode = vbKeyC Then
Clipboard.Clear
Clipboard.SetText Text1.Text
Else
KeyCode = 0
End If
End If
End Sub
----------------模块代码---------------------
程序代码：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
If r1(i).v > 0 Then
For j = 1 To 4
If r2(j).v >= 0 Then
Call operation(r1(i), r2(j), 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
'第二分支，第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
'先第2、3数运算后，再与第1数运算，第4数运算。
Call operation(l2, l3, r1)
For i = 1 To 4
If r1(i).v > 0 Then
Call operation(l1, r1(i), 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
'先第2、3数运算后，再与第4数运算，第1数运算。
Call operation(l2, l3, r1)
For i = 1 To 4
If r1(i).v > 0 Then
Call operation(r1(i), l4, r2)
For j = 1 To 4
If r2(j).v > 0 Then
Call operation(l1, r2(j), 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
'先第3、4数运算后，再与第2数运算，第1数运算。
Call operation(l3, l4, r1)
For i = 1 To 4
If r1(i).v > 0 Then
Call operation(l2, r1(i), r2)
For j = 1 To 4
If r2(j).v > 0 Then
Call operation(l1, r2(j), 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
Dim s1 As String, s2 As String
'如果前一次没做乘除法，并且是表达式，则先加好括号，留给 减 乘 除 用
If Len(a.s) > 2 And (InStr(1, a.s, "+") > 0 Or InStr(1, a.s, "-") > 0) Then '>2，是因为10＝2，而表达式，去掉空格也最少=3
s1 = "( " & a.s & " )"
Else
s1 = a.s
End If
If Len(b.s) > 2 And (InStr(1, b.s, "+") > 0 Or InStr(1, b.s, "-") > 0) Then
s2 = "( " & b.s & " )"
Else
s2 = b.s
End If
'加法
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 & " - " & s2 & " "
Else
r(2).v = -1
End If
'乘法
r(3).v = a.v * b.v
r(3).s = " " & s1 & " * " & s2 & " " '使用可能增加了括号的表达式组合
'除法，只允许整除
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 = " " & s1 & " / " & s2 & " " '使用可能增加了括号的表达式组合
Else
r(4).v = -1
End If
Else
r(4).v = -1
End If
End Sub
[ 本帖最后由 风吹过b 于 2015-6-18 22:57 编辑 ]
24点3.rar
只能说风版做得太认真了，要求也高。
