用Excel VBA编写的24点游戏算法

Raymond1st

关于24点游戏的算法，我在网上看到很多帖子说用递归法比较好，但是我水平有限，写不出很简单的递归法脚本，我用穷举法写了一个脚本，虽然语句行数不算少，但是程序结构还比较简单，运算速度也比较快，请各位大师指点一下我的脚本还能怎样优化，我想学习一下。

注：里面的自定义函数受到了狼斑竹之前一个帖子的启发，特此鸣谢！

赵国辉

好贴

guzhen9315

很好！顶一个！

但经本人不完全测试：
11 × 12 - 9 × 12＝24                 但显示无解       

类似的有：
7        12        9        12
7        12        5        12

warriorcold

好东西，顶顶

inadequate

水平很高，顶一个

hhzjxss

下载看看，谢谢分享！

pt98

原帖由 guzhen9315 于 2009-12-13 09:16 发表
很好！顶一个！

但经本人不完全测试：
11 × 12 - 9 × 12＝24                 但显示无解       

类似的有：
7        12        9        12
7        12        5        12

'这个可以，除了24也可以算其它的，也不光只用4个数
Option Explicit
Const PRECISION = 0.000001
Const COUNT_OF_NUMBER = 4 '4个数，可以更多或更少
Const NUMBER_TO_CAL = 24 '结果可以更小或更大
Dim number(COUNT_OF_NUMBER) As Double
Dim expression(COUNT_OF_NUMBER) As String

Function Search(n) As Boolean
    Dim i As Integer, j As Integer
    If n = 1 Then
        If (Abs(number(0) - NUMBER_TO_CAL) < PRECISION) Then
            Search = True
        Else
            Search = False
        End If
        Exit Function
    End If
    For i = 0 To n - 1
        For j = i + 1 To n - 1
            Dim A As Double, B As Double
            Dim expA As String, expB As String
            A = number(i)
            B = number(j)
            number(j) = number(n - 1)
            expA = expression(i)
            expB = expression(j)
            expression(j) = expression(n - 1)
            expression(i) = "(" + expA + "+" + expB + ")"
            number(i) = A + B
            If (Search(n - 1)) Then
                    Search = True
                    Exit Function
            End If
            expression(i) = "(" + expA + "-" + expB + ")"
            number(i) = A - B
            If (Search(n - 1)) Then
                    Search = True
                    Exit Function
            End If
            expression(i) = "(" + expB + "-" + expA + ")"
            number(i) = B - A
            If (Search(n - 1)) Then
                    Search = True
                    Exit Function
            End If
            expression(i) = "(" + expA + "*" + expB + ")"
            number(i) = A * B
            If (Search(n - 1)) Then
                    Search = True
                    Exit Function
            End If
            If B <> 0 Then
                expression(i) = "(" + expA + "/" + expB + ")"
                number(i) = A / B
                If (Search(n - 1)) Then
                    Search = True
                    Exit Function
                End If
            End If
            If A <> 0 Then
                expression(i) = "(" + expB + "/" + expA + ")"
                number(i) = B / A
                If (Search(n - 1)) Then
                    Search = True
                    Exit Function
                End If
            End If
            number(i) = A
            number(j) = B
            expression(i) = expA
            expression(j) = expB
        Next
    Next
    Search = False
End Function

Sub test()
    Dim x As Integer, i As Integer
    For i = 0 To COUNT_OF_NUMBER - 1
        x = InputBox("输入第" & (i + 1) & "个数", COUNT_OF_NUMBER & "个数算" & NUMBER_TO_CAL)
        number(i) = x
        expression(i) = CStr(x)
    Next
    If Search(COUNT_OF_NUMBER) Then
        MsgBox expression(0) & "=" & CStr(NUMBER_TO_CAL)
    Else
        MsgBox "无解"
    End If
End Sub

hwx222727

谢谢分享，下来学习！

peizhsh005

谢谢分享，好人啊！

peizhsh005

学习了，非常感谢！