首先，我們先看看這個游戲的規則，給出4個1-9之間的自然數，例如：1，5，5，5（這是很經典的一個例子哦 ^_^）。在1，5，5，5中間用+、-、*、/來運算后得到24這個數。每個數只能使用一次。如果沒有計算過的基本都會被難住吧。哈哈，答案是 5*（5-1/5）。是不是很經典呢？和它類似的還有3，3，8，8。

    下面我們來看具體算法。一般我們考慮這樣的問題的時候，都是直接寫一個超大的select來判斷。但重復性的工作是最無聊的��！我們來分析一下這個簡單的游戲規則就可以找到一個簡單的方法。

    例如：4個數A、B、C、D，我們可以用F(A,B,C,D)=24來表示。那么。我們就可以把函數F拆解成F1(B,C,D)=P1(24,A)。（意思是：B，C，D之間的四則運算可以得到A和24之間的四則運算結果）。那么F1又可以繼續拆解為C和D之間的四則運算關系得到結果后再和B來一次四則運算結果。這樣，就可以得到很簡單的一個數組6*6*6=216種結果而已。當然，這是A，B，C，D順序固定的組合，那么把A，B，C，D換個位置，又一種組合。所以，所有的結果有6*6*6*12種。但，我們還是忽略了一種情況：A和B的值與C和D的值再進行四則運算，那么我們還需要再加一組6*6*6就可以了。

    好了，不多說了，大家自己看下面的代碼吧。

'--------------------------------計算24的算法---------------------------
'        算法作者：CSDN(penguinMII)--企鵝
'        開發時間：2005-3-23
'        如有引用此算法請保留此信息
'-----------------------------------------------------------------------

'關于F1(F2(F3(a1,a2),a3),a4)的變量定義
Dim f_f(0 To 5) As Double               '2個數之間運算后的6種結果
Dim s_s(0 To 5) As String               '2個數之間運算后的表達式
Dim f_f_f(0 To 5) As Double             '第3個數和上面2數運算后的結果
Dim s_s_s(0 To 5) As String             '第3個數和上面2數運算后的表達式
Dim f_f_f_f(0 To 5) As Double           '第4個數和上面3數運算后的結果
Dim s_s_s_s(0 To 5) As String           '第4個數和上面3數運算后的結果
'關于F1(F2(a1,a2),F3(a3,a4))的變量定義
Dim f_f1(0 To 5) As Double              '第3個數第4個數運算結果
Dim s_s1(0 To 5) As String              '第3個數第4個數運算后的表達式
Dim f_f2(0 To 5) As Double              '第1、2數和第3、4個數運算后的結果
Dim s_s2(0 To 5) As String              '第1、2數和第3、4個數運算后的表達式

Sub ff2(x As Double, y As Double, sx As String, sy As String)
On Error Resume Next
f_f2(0) = x + y
s_s2(0) = "(" + sx + "+" + sy + ")"
f_f2(1) = x - y
s_s2(1) = "(" + sx + "-" + sy + ")"
f_f2(2) = y - x
s_s2(2) = "(" + sy + "-" + sx + ")"
f_f2(3) = x * y
s_s2(3) = "(" + sx + "*" + sy + ")"
f_f2(4) = x / y
s_s2(4) = "(" + sx + "/" + sy + ")"
f_f2(5) = y / x
s_s2(5) = "(" + sy + "/" + sx + ")"

End Sub

Sub ff1(x As Integer, y As Integer)
On Error Resume Next
f_f1(0) = x + y
s_s1(0) = "(" + CStr(x) + "+" + CStr(y) + ")"
f_f1(1) = x - y
s_s1(1) = "(" + CStr(x) + "-" + CStr(y) + ")"
f_f1(2) = y - x
s_s1(2) = "(" + CStr(y) + "-" + CStr(x) + ")"
f_f1(3) = x * y
s_s1(3) = "(" + CStr(x) + "*" + CStr(y) + ")"
f_f1(4) = x / y
s_s1(4) = "(" + CStr(x) + "/" + CStr(y) + ")"
f_f1(5) = y / x
s_s1(5) = "(" + CStr(y) + "/" + CStr(x) + ")"

End Sub

Sub ff(x As Integer, y As Integer)
On Error Resume Next
f_f(0) = x + y
s_s(0) = "(" + CStr(x) + "+" + CStr(y) + ")"
f_f(1) = x - y
s_s(1) = "(" + CStr(x) + "-" + CStr(y) + ")"
f_f(2) = y - x
s_s(2) = "(" + CStr(y) + "-" + CStr(x) + ")"
f_f(3) = x * y
s_s(3) = "(" + CStr(x) + "*" + CStr(y) + ")"
f_f(4) = x / y
s_s(4) = "(" + CStr(x) + "/" + CStr(y) + ")"
f_f(5) = y / x
s_s(5) = "(" + CStr(y) + "/" + CStr(x) + ")"

End Sub

Sub fff(x As Integer, y As Double, s As String)
On Error Resume Next
f_f_f(0) = x + y
s_s_s(0) = "(" + CStr(x) + "+" + s + ")"
f_f_f(1) = x - y
s_s_s(1) = "(" + CStr(x) + "-" + s + ")"
f_f_f(2) = y - x
s_s_s(2) = "(" + s + "-" + CStr(x) + ")"
f_f_f(3) = x * y
s_s_s(3) = "(" + CStr(x) + "*" + s + ")"
f_f_f(4) = x / y
s_s_s(4) = "(" + CStr(x) + "/" + s + ")"
f_f_f(5) = y / x
s_s_s(5) = "(" + s + "/" + CStr(x) + ")"

End Sub

Sub ffff(x As Integer, y As Double, s As String)
On Error Resume Next
f_f_f_f(0) = x + y
s_s_s_s(0) = "(" + CStr(x) + "+" + s + ")"
f_f_f_f(1) = x - y
s_s_s_s(1) = "(" + CStr(x) + "-" + s + ")"
f_f_f_f(2) = y - x
s_s_s_s(2) = "(" + s + "-" + CStr(x) + ")"
f_f_f_f(3) = x * y
s_s_s_s(3) = "(" + CStr(x) + "*" + s + ")"
f_f_f_f(4) = x / y
s_s_s_s(4) = "(" + CStr(x) + "/" + s + ")"
f_f_f_f(5) = y / x
s_s_s_s(5) = "(" + s + "/" + CStr(x) + ")"

End Sub

Sub ppp(a1 As Integer, a2 As Integer, a3 As Integer, a4 As Integer)
Dim tempp As Integer

tempp = 0

Call ff(a1, a2)
For i = 0 To 5
Call fff(a3, f_f(i), s_s(i))
For j = 0 To 5
Call ffff(a4, f_f_f(j), s_s_s(j))
For k = 0 To 5
If f_f_f_f(k) > 23.99999 And f_f_f_f(k) < 24.00001 Then

tempp = 0
For xyz = 0 To Me.List1.ListCount - 1
If Me.List1.List(xyz) = s_s_s_s(k) Then
tempp = tempp + 1
End If
Next xyz

If tempp = 0 Then
Me.List1.AddItem s_s_s_s(k)
End If

End If
Next k
Next j
Next i

End Sub

Sub qqq(a1 As Integer, a2 As Integer, a3 As Integer, a4 As Integer)
Dim tempp As Integer
tempp = 0

Call ff(a1, a2)
Call ff1(a3, a4)
For i = 0 To 5
For j = 0 To 5
Call ff2(f_f(i), f_f1(j), s_s(i), s_s1(j))
For k = 0 To 5
If f_f2(k) > 23.9999 And f_f2(k) < 24.00001 Then

tempp = 0
For xyz = 0 To Me.List1.ListCount - 1
If Me.List1.List(xyz) = s_s2(k) Then
tempp = tempp + 1
End If
Next xyz

If tempp = 0 Then
Me.List1.AddItem s_s2(k)
End If

End If
Next k
Next j
Next i
End Sub

Private Sub Command1_Click()
Me.List1.Clear

Call ppp(Me.Text1(0).Text, Me.Text1(1).Text, Me.Text1(2).Text, Me.Text1(3).Text)
Call ppp(Me.Text1(0).Text, Me.Text1(1).Text, Me.Text1(3).Text, Me.Text1(2).Text)
Call ppp(Me.Text1(0).Text, Me.Text1(2).Text, Me.Text1(1).Text, Me.Text1(3).Text)
Call ppp(Me.Text1(0).Text, Me.Text1(2).Text, Me.Text1(3).Text, Me.Text1(1).Text)
Call ppp(Me.Text1(0).Text, Me.Text1(3).Text, Me.Text1(1).Text, Me.Text1(2).Text)
Call ppp(Me.Text1(0).Text, Me.Text1(3).Text, Me.Text1(2).Text, Me.Text1(1).Text)
Call ppp(Me.Text1(1).Text, Me.Text1(2).Text, Me.Text1(3).Text, Me.Text1(0).Text)
Call ppp(Me.Text1(1).Text, Me.Text1(2).Text, Me.Text1(0).Text, Me.Text1(3).Text)
Call ppp(Me.Text1(1).Text, Me.Text1(3).Text, Me.Text1(0).Text, Me.Text1(2).Text)
Call ppp(Me.Text1(1).Text, Me.Text1(3).Text, Me.Text1(2).Text, Me.Text1(0).Text)
Call ppp(Me.Text1(2).Text, Me.Text1(3).Text, Me.Text1(1).Text, Me.Text1(0).Text)
Call ppp(Me.Text1(2).Text, Me.Text1(3).Text, Me.Text1(0).Text, Me.Text1(1).Text)

Call qqq(Me.Text1(0).Text, Me.Text1(1).Text, Me.Text1(2).Text, Me.Text1(3).Text)

End Sub