ジャマイカ2
これでたぶん完成。
Option Explicit Public Type Enzan s As Double n As String k As Integer End Type Private r As Long Private hai() As String Private c1 As Integer Sub Shoot() Columns("B").Value = "" Dim c For Each c In Array("Num1", "Num2", "Num3", "Num4", "Num5", "GNum2") Range(c).Value = Int(Rnd() * 6) + 1 Next Range("GNum1").Value = 10 * (Int(Rnd() * 6) + 1) End Sub 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 = 2 For i = 0 To 4 e(i).s = Range("Num" & i + 1).Value e(i).n = Range("Num" & i + 1).Value 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 s1 = e(i1).s n1 = e(i1).n k1 = e(i1).k s2 = e(i2).s 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 f2 = False e = e1 n5 = n1 n6 = n2 Select Case i3 Case 0 e(j - 1).s = s1 + s2 e(j - 1).n = n5 & "+" & n6 Case 1 e(j - 1).s = s1 - s2 If k2 < 3 Then n6 = "(" & n2 & ")" End If e(j - 1).n = n5 & "-" & n6 Case 2 e(j - 1).s = s2 - s1 If k1 < 3 Then n5 = "(" & n1 & ")" End If e(j - 1).n = n6 & "-" & n5 Case 3 e(j - 1).s = s1 * s2 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 s2 <> 0 Then e(j - 1).s = s1 / s2 If k1 < 3 Then n5 = "(" & n1 & ")" End If If Len(n2) > 1 Then n6 = "(" & n2 & ")" End If e(j - 1).n = n5 & "/" & n6 Else f2 = True End If Case 5 If s1 <> 0 Then e(j - 1).s = s2 / s1 If k2 < 3 Then n6 = "(" & n2 & ")" End If If Len(n1) > 1 Then n5 = "(" & n1 & ")" End If e(j - 1).n = n6 & "/" & n5 Else f2 = True End If End Select If Not f2 Then e(j - 1).k = i3 e(j).s = 0 e(j).n = "" e(j).k = 3 If j > 1 Then Call Saiki(e, j - 1) Else If e(0).s = Range("GNum1").Value + Range("GNum2").Value Then 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, 2).Value = e(0).n r = r + 1 End If End If 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