4个数计算24点

来源：互联网发布：小霸王网络机顶盒编辑：程序博客网时间：2024/05/17 22:32

Option Explicit

Public Function Cal24P(n1 As Long, n2 As Long, n3 As Long, n4 As Long) As String
    Dim A(3) As Double
    Dim Op(3) As String

    A(0) = n1
    A(1) = n2
    A(2) = n3
    A(3) = n4

    Op(0) = n1
    Op(1) = n2
    Op(2) = n3
    Op(3) = n4


        Cal24P = CalxTmp(A, Op, 3)

End Function

Private Function CalxTmp(A() As Double, Op() As String, ByVal mMax As Long) As String
    Dim i As Long, j As Long, K As Long, L As Long
    Dim m As Double
    Dim s As String, s1 As String
    Dim bMarch As Boolean

    Dim B() As Double
    Dim OpTmp() As String

    ReDim B(mMax - 1)
    ReDim OpTmp(mMax - 1)


    For i = 0 To mMax
        For j = 1 To mMax
            If i <> j Then
                L = 0
                For K = 0 To mMax
                    If K <> i And K <> j Then
                        B(L) = A(K)
                        OpTmp(L) = Op(K)
                        L = L + 1
                    End If
                Next


                m = A(i) + A(j)
                OpTmp(mMax - 1) = "(" & Op(i) & "+" & Op(j) & ")"
                If mMax = 1 Then
                    If Abs(m - 24) < 0.00000001 Then
                        CalxTmp = OpTmp(mMax - 1)
                        Exit Function
                    End If
                Else
                    B(mMax - 1) = m
                    CalxTmp = CalxTmp(B, OpTmp, mMax - 1)
                End If

                If CalxTmp <> "" Then Exit Function
                m = A(i) - A(j)
                OpTmp(mMax - 1) = "(" & Op(i) & "-" & Op(j) & ")"
                If mMax = 1 Then
                    If Abs(m - 24) < 0.00000001 Then
                        CalxTmp = OpTmp(mMax - 1)
                        Exit Function
                    End If
                Else
                    B(mMax - 1) = m
                    CalxTmp = CalxTmp(B, OpTmp, mMax - 1)
                End If

                If CalxTmp <> "" Then Exit Function
                m = A(j) - A(i)
                OpTmp(mMax - 1) = "(" & Op(j) & "-" & Op(i) & ")"
                If mMax = 1 Then
                    If Abs(m - 24) < 0.00000001 Then
                        CalxTmp = OpTmp(mMax - 1)
                        Exit Function
                    End If
                Else
                    B(mMax - 1) = m
                    CalxTmp = CalxTmp(B, OpTmp, mMax - 1)
                End If

                If CalxTmp <> "" Then Exit Function
                m = A(i) * A(j)
                OpTmp(mMax - 1) = "(" & Op(i) & "*" & Op(j) & ")"
                If mMax = 1 Then
                    If Abs(m - 24) < 0.00000001 Then
                        CalxTmp = OpTmp(mMax - 1)
                        Exit Function
                    End If
                Else
                    B(mMax - 1) = m
                    CalxTmp = CalxTmp(B, OpTmp, mMax - 1)
                End If

                If CalxTmp <> "" Then Exit Function
                If A(j) <> 0 Then
                    m = A(i) / A(j)
                    OpTmp(mMax - 1) = "(" & Op(i) & "/" & Op(j) & ")"
                    If mMax = 1 Then
                        If Abs(m - 24) < 0.00000001 Then
                            CalxTmp = OpTmp(mMax - 1)
                            Exit Function
                        End If
                    Else
                        B(mMax - 1) = m
                        CalxTmp = CalxTmp(B, OpTmp, mMax - 1)
                    End If
                End If

                If CalxTmp <> "" Then Exit Function
                If A(i) <> 0 Then
                    m = A(j) / A(i)
                    OpTmp(mMax - 1) = "(" & Op(j) & "/" & Op(i) & ")"
                    If mMax = 1 Then
                        If Abs(m - 24) < 0.00000001 Then
                            CalxTmp = OpTmp(mMax - 1)
                            Exit Function
                        End If
                    Else
                        B(mMax - 1) = m
                        CalxTmp = CalxTmp(B, OpTmp, mMax - 1)
                    End If
                End If
            End If
        Next
    Next
End Function