在a1,a2,a3,a4单元格内输入数字,如果能算24点的话在b列显示解法,如果有多种解法则分别在b1,b2...中显示:
Sub get24p()
Const p24 = "123412431324134214231432213421432314234124132431312431423214324134123421412341324213423143124321"
Dim A As Integer, B As Integer, C As Integer, D As Integer
Dim i As Integer, answer As New Collection, ARR(1 To 65536, 1 To 1) As String, K As Integer
On Error Resume Next
For i = 0 To 23
A = Cells(Mid(p24, i * 4 + 1, 1), 1)
B = Cells(Mid(p24, i * 4 + 2, 1), 1)
C = Cells(Mid(p24, i * 4 + 3, 1), 1)
D = Cells(Mid(p24, i * 4 + 4, 1), 1)
If A <= B And B <= C And C <= D Then answer.Add A & "+" & B & "+" & C & "+" & D & "=24", A & "+" & B & "+" & C & "+" & D & "=24"
If B <= C Then answer.Add A & "+(" & B & "+" & C & ")/" & D & "=24", A & "+(" & B & "+" & C & ")/" & D & "=24"
If A <= B Then answer.Add A & "+" & B & "+" & C & "-" & D & "=24", A & "+" & B & "+" & C & "-" & D & "=24"
If B > C / D Then answer.Add A & "/(" & B & "-" & C & "/" & D & ")" & "=24", A & "/(" & B & "-" & C & "/" & D & ")" & "=24"
If C <= D Then answer.Add A & "/" & B & "+" & C & "+" & D & "=24", A & "/" & B & "+" & C & "+" & D & "=24"
If B <= C Then answer.Add A & "*(" & B & "+" & C & "/" & D & ")" & "=24", A & "*(" & B & "+" & C & "/" & D & ")" & "=24"
If B <= C Then answer.Add A & "*(" & B & "+" & C & ")+" & D & "=24", A & "*(" & B & "+" & C & ")+" & D & "=24"
If B <= C Then answer.Add A & "*(" & B & "+" & C & ")-" & D & "=24", A & "*(" & B & "+" & C & ")-" & D & "=24"
If C <= D Then answer.Add A & "*" & B & "+" & C & "+" & D & "=24", A & "*" & B & "+" & C & "+" & D & "=24"
If A <= B And C <= D Then answer.Add A & "*" & B & "+" & C & "*" & D & "=24", A & "*" & B & "+" & C & "*" & D & "=24"
If A <= B Then answer.Add A & "*" & B & "+" & C & "-" & D & "=24", A & "*" & B & "+" & C & "-" & D & "=24"
If A <= B Then answer.Add A & "*" & B & "/" & C & "+" & D & "=24", A & "*" & B & "/" & C & "+" & D & "=24"
If A <= B And C <= D Then answer.Add A & "*" & B & "/" & C & "/" & D & "=24", A & "*" & B & "/" & C & "/" & D & "=24"
If A <= B Then answer.Add A & "*" & B & "/" & C & "-" & D & "=24", A & "*" & B & "/" & C & "-" & D & "=24"
If A <= B And B <= C Then answer.Add A & "*" & B & "*" & C & "+" & D & "=24", A & "*" & B & "*" & C & "+" & D & "=24"
If A <= B And B <= C Then answer.Add A & "*" & B & "*" & C & "/" & D & "=24", A & "*" & B & "*" & C & "/" & D & "=24"
If A <= B And B <= C And C <= D Then answer.Add A & "*" & B & "*" & C & "*" & D & "=24", A & "*" & B & "*" & C & "*" & D & "=24"
If A <= B And B <= C Then answer.Add A & "*" & B & "*" & C & "-" & D & "=24", A & "*" & B & "*" & C & "-" & D & "=24"
If A <= B And C <= D Then answer.Add A & "*" & B & "-" & C & "*" & D & "=24", A & "*" & B & "-" & C & "*" & D & "=24"
If A <= B And B <= C Then answer.Add "(" & A & "+" & B & "+" & C & ")/" & D & "=24", "(" & A & "+" & B & "+" & C & ")/" & D & "=24"
If A <= B And B <= C Then answer.Add "(" & A & "+" & B & "+" & C & ")*" & D & "=24", "(" & A & "+" & B & "+" & C & ")*" & D & "=24"
If A <= B And C <= D And A * B <= C * D Then answer.Add "(" & A & "+" & B & ")*(" & C & "+" & D & ")=24", "(" & A & "+" & B & ")*(" & C & "+" & D & ")=24"
If A <= B Then answer.Add "(" & A & "+" & B & ")*(" & C & "-" & D & ")=24", "(" & A & "+" & B & ")*(" & C & "-" & D & ")=24"
If A <= B Then answer.Add "(" & A & "+" & B & ")*" & C & "/" & D & "=24", "(" & A & "+" & B & ")*" & C & "/" & D & "=24"
If A <= B And C <= D Then answer.Add "(" & A & "+" & B & ")*" & C & "*" & D & "=24", "(" & A & "+" & B & ")*" & C & "*" & D & "=24"
If A <= B Then answer.Add "(" & A & "+" & B & "-" & C & ")*" & D & "=24", "(" & A & "+" & B & "-" & C & ")*" & D & "=24"
If A >= B And C >= D Then answer.Add "(" & A & "-" & B & ")*(" & C & "-" & D & ")=24", "(" & A & "-" & B & ")*(" & C & "-" & D & ")=24"
If C <= D Then answer.Add "(" & A & "-" & B & ")*" & C & "*" & D & "=24", "(" & A & "-" & B & ")*" & C & "*" & D & "=24"
answer.Add "(" & A & "-" & B & "/" & C & ")*" & D & "=24", "(" & A & "-" & B & "/" & C & ")*" & D & "=24"
answer.Add A & "*(" & B & "-" & C & ")+" & D & "=24", A & "*(" & B & "-" & C & ")+" & D & "=24"
answer.Add A & "*(" & B & "-" & C & ")-" & D & "=24", A & "*(" & B & "-" & C & ")-" & D & "=24"
answer.Add "(" & A & "-" & B & ")*" & C & "/" & D & "=24", "(" & A & "-" & B & ")*" & C & "/" & D & "=24"
Next
For i = 1 To answer.Count
If Application.Evaluate(answer(i)) = True Then
K = K + 1
ARR(K, 1) = answer(i)
End If
Next
If K = 0 Then ARR(1, 1) = "无解!"
Application.ScreenUpdating = False
Range("B1:B65536") = ARR
Range("B1:B65536").Columns.AutoFit
Application.ScreenUpdating = True
MsgBox "找到了" & K & "个解!!!"
End Sub