ジャマイカ、まとめ

http://q.hatena.ne.jp/1256711755

結局のところ今の時点でプログラム的に全ての回答を出せるのは自分の回答しか無かったようです。質問者様にはドンマイとだけ言いたい。

Mookさんのパターン表に抜けている部分は手作業で追加するのは容易でも、その「あらかじめ計算パターンを計算するマクロ」に取り込むのはけっこう難しかったりします。

因みに私のコードは少し変形するだけで１５秒程で完全に重複の無い全てのパターンを作れてしまうので紹介しておきます。
それと私の回答はある意味矛盾を含みます。それについてはわかる人もいないので書かなくてもいいかな。

Option Explicit

Public Type Enzan
    n As String
    k As Integer
End Type

Private r As Long
Private hai() As String
Private c1 As Integer

Sub jamaica()
    Dim i As Integer
    Dim e(4) As Enzan
    Dim stTime
    ReDim hai(0)
    
    stTime = Time
    Range("AF1:AF5").NumberFormatLocal = "@"
    Columns("B").Value = ""
    
    Application.ScreenUpdating = False
    
    r = 1
    
    For i = 0 To 4
        e(i).n = "#"
        e(i).k = 3
    Next i

    Call Saiki(e, 4)

    If Range("B2") = "" Then Range("B2") = "NO ANSWER"
    Application.StatusBar = DatePart("s", Time - stTime) & "秒"
    Range("AF1:AF5").Value = ""

    Application.ScreenUpdating = True
End Sub

Sub Saiki(e3() As Enzan, j As Integer)
    Dim i1 As Integer
    Dim i2 As Integer
    Dim i3 As Integer
    Dim s1 As Double
    Dim s2 As Double
    Dim n1 As String
    Dim n2 As String
    Dim k1 As Integer
    Dim k2 As Integer
    Dim c As Integer
    Dim i As Integer
    Dim e() As Enzan
    Dim e1() As Enzan
    Dim n5 As String
    Dim n6 As String
    Dim str As String
    Dim f2 As Boolean
    Dim f3 As Boolean
    Dim f4 As Boolean
    Dim h1(10) As String
    Dim h2(10) As String
    Dim c2 As Integer
    
    c2 = 0
    For i1 = 0 To j - 1
        For i2 = i1 + 1 To j
            f4 = False
            For i = 0 To c2
                If (h1(i) = e3(i1).n And h2(i) = e3(i2).n) Or (h1(i) = e3(i2).n And h2(i) = e3(i1).n) Then
                    f4 = True
                    Exit For
                End If
            Next i
            If Not f4 Then
                c2 = c2 + 1
                h1(c2) = e3(i1).n
                h2(c2) = e3(i2).n
                
                e = e3
                n1 = e(i1).n
                k1 = e(i1).k
                n2 = e(i2).n
                k2 = e(i2).k
                c = 0
                For i = 0 To j
                    If i <> i1 And i <> i2 Then
                        e(c) = e(i)
                        c = c + 1
                    End If
                Next i
                e1 = e
                For i3 = 0 To 5
                    DoEvents
                    e = e1
                    n5 = n1
                    n6 = n2
                    Select Case i3
                        Case 0
                            e(j - 1).n = n5 & "+" & n6
                        Case 1
                            If k2 < 3 Then
                                n6 = "(" & n2 & ")"
                            End If
                            e(j - 1).n = n5 & "-" & n6
                        Case 2
                            If k1 < 3 Then
                                n5 = "(" & n1 & ")"
                            End If
                            e(j - 1).n = n6 & "-" & n5
                        Case 3
                            If k1 < 3 Then
                                n5 = "(" & n1 & ")"
                            End If
                            If k2 < 3 Then
                                n6 = "(" & n2 & ")"
                            End If
                            e(j - 1).n = n5 & "*" & n6
                        Case 4
                                If k1 < 3 Then
                                    n5 = "(" & n1 & ")"
                                End If
                                If Len(n2) > 1 Then
                                    n6 = "(" & n2 & ")"
                                End If
                                e(j - 1).n = n5 & "/" & n6
                        Case 5
                                If k2 < 3 Then
                                    n6 = "(" & n2 & ")"
                                End If
                                If Len(n1) > 1 Then
                                    n5 = "(" & n1 & ")"
                                End If
                                e(j - 1).n = n6 & "/" & n5
                    End Select
                    e(j - 1).k = i3
                    e(j).n = ""
                    e(j).k = 3
                    If j > 1 Then
                        Call Saiki(e, j - 1)
                    Else
                        str = Sort(e(0).n)
                        f3 = False
                        For i = 0 To UBound(hai)
                            If hai(i) = str Then
                                f3 = True
                                Exit For
                            End If
                        Next i
                        If Not f3 Then
                            ReDim Preserve hai(c1)
                            hai(c1) = str
                            c1 = c1 + 1
                            Cells(r, 1).Value = e(0).n
                            r = r + 1
                        End If
                    End If
                Next i3
            End If
        Next i2
    Next i1
End Sub

Function Sort(ByVal s As String) As String
    Dim i As Integer
    Dim j As Integer
    Dim f As Boolean
    Dim h(9) As Variant
    Dim c As Integer
    Dim sp As Integer
    Dim ep As Integer
    Dim st As String
    Dim res As String
    Dim str As String
    Dim m1 As String
    Dim m2 As String
    
    For i = 1 To Len(s)
        Select Case Mid(s, i, 1)
            Case "+", "-"
                If j = 0 Then
                    f = True
                End If
            Case "("
                j = j + 1
            Case ")"
                j = j - 1
        End Select
    Next i
    
    j = 0
    sp = 1
    If f Then
        m1 = "+"
        m2 = "-"
    Else
        m1 = "*"
        m2 = "/"
    End If
    s = m1 & s
    For i = 1 To Len(s)
        Select Case Mid(s, i, 1)
            Case m1, m2
                If j = 0 Then
                    If sp > 1 Then
                        str = Mid(s, sp, i - sp)
                        If i - sp > 1 Then
                            If Check(str) Then
                                h(c) = st & "(" & Sort(Mid(str, 2, Len(str) - 2)) & ")"
                            Else
                                h(c) = st & Sort(str)
                            End If
                        Else
                            h(c) = st & str
                        End If
                        c = c + 1
                    End If
                    h(c) = m1
                    st = Mid(s, i, 1)
                    c = c + 1
                    sp = i + 1
                End If
            Case "("
                j = j + 1
            Case ")"
                j = j - 1
        End Select
    Next i
    str = Mid(s, sp, i - sp)
    If i - sp > 1 Then
        If Check(str) Then
            h(c) = st & "(" & Sort(Mid(str, 2, Len(str) - 2)) & ")"
        Else
            h(c) = st & Sort(str)
        End If
    Else
        h(c) = st & str
    End If

    
    For i = 1 To 5
        Cells(i, "AF").Value = h(i * 2 - 1)
    Next i
    Range("AF1:AF5").Sort Key1:=Range("AF1")
    For i = 1 To 5
        h(i * 2 - 1) = Cells(i, "AF").Value
    Next i
    
    For i = 0 To 9
        res = res & h(i)
    Next
    
    Sort = res
End Function

Function Check(s As String) As Boolean
    Dim i As Integer
    Dim j As Integer
    Dim f As Boolean
    
    If Left(s, 1) = "(" And Right(s, 1) = ")" Then
        f = True
        For i = 1 To Len(s)
            Select Case Mid(s, i, 1)
                Case "("
                    j = j + 1
                Case ")"
                    j = j - 1
                    If j = 0 And i <> Len(s) Then
                        f = False
                        Exit For
                    End If
            End Select
        Next i
    End If
    Check = f
End Function