Public x1, x2, x3, x4 As Byte
Sub Opérateurs_Staple()
Dim op() As Variant
Dim f1, f2, f3, f4, f5 As String, cl As Integer
Dim formule As New Collection, combinaison As New Collection
Range("A:A").ClearContents
op = Array("+", "-", "*", "/")
For x1 = 1 To 9
For x2 = 1 To 9
For x3 = 1 To 9
For x4 = 1 To 9
For o1 = 0 To 3
For o2 = 0 To 3
For o3 = 0 To 3
f1 = Epur("(" & x1 & op(o1) & x2 & ")" & op(o2) & x3 & op(o3) & x4)
f2 = Epur(x1 & op(o1) & "(" & x2 & op(o2) & x3 & ")" & op(o3) & x4)
f3 = Epur("(" & x1 & op(o1) & x2 & ")" & op(o2) & "(" & x3 & op(o3) & x4 & ")")
f4 = Epur("(" & x1 & op(o1) & x2 & op(o2) & x3 & ")" & op(o3) & x4)
f5 = Epur(x1 & op(o1) & "(" & x2 & op(o2) & x3 & op(o3) & x4 & ")")
If IsError(Evaluate(f1)) Then GoTo 1
If Abs(Evaluate(f1) - 24) < 10 ^ -13 Then
cl = mini(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, CStr(cl) 'méthode donnée par skoobi le 23/10/08
If Err = 0 Then Range("A" & combinaison.Count) = cl
formule.Add f1, f1
On Error GoTo 0
End If
1 If IsError(Evaluate(f2)) Then GoTo 2
If Abs(Evaluate(f2) - 24) < 10 ^ -13 Then
cl = mini(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, CStr(cl)
If Err = 0 Then Range("A" & combinaison.Count) = cl
formule.Add f2, f2
On Error GoTo 0
End If
2 If IsError(Evaluate(f3)) Then GoTo 3
If Abs(Evaluate(f3) - 24) < 10 ^ -13 Then
cl = mini(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, CStr(cl)
If Err = 0 Then Range("A" & combinaison.Count) = cl
formule.Add f3, f3
On Error GoTo 0
End If
3 If IsError(Evaluate(f4)) Then GoTo 4
If Abs(Evaluate(f4) - 24) < 10 ^ -13 Then
cl = mini(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, CStr(cl)
If Err = 0 Then Range("A" & combinaison.Count) = cl
formule.Add f4, f4
On Error GoTo 0
End If
4 If IsError(Evaluate(f5)) Then GoTo 5
If Abs(Evaluate(f5) - 24) < 10 ^ -13 Then
cl = mini(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, CStr(cl)
If Err = 0 Then Range("A" & combinaison.Count) = cl
formule.Add f5, f5
On Error GoTo 0
End If
5 Next
Next
Next
Next
Next
Next
Next
MsgBox "Formules " & formule.Count
MsgBox "Combinaisons " & combinaison.Count
End Sub
Function mini(x1, x2, x3, x4) 'créée par pierrejean le 23/10/08
tablo = Array(x1, x2, x3, x4)
For n = LBound(tablo) To UBound(tablo)
For m = LBound(tablo) To UBound(tablo)
If tablo(m) > tablo(n) Then
temp = tablo(n)
tablo(n) = tablo(m)
tablo(m) = temp
End If
Next m
Next n
For n = LBound(tablo) To UBound(tablo)
mini = mini & tablo(n)
Next n
End Function
Function Epur(f$)
'suppression des parenthèses inutiles
For i = 1 To 7 Step 2
If Mid(f, i, 1) = "(" Then
j = Application.Find(")", f, i)
x = Mid(f, i + 1, j - 1 - i)
If IsError(Application.Find("+", x)) And IsError(Application.Find("-", x)) _
Or Mid(f, IIf(i > 1, i - 1, 1), 1) = "+" _
Or IIf(j = 7, Mid(f, 8, 1), 0) = "+" Or IIf(j = 7, Mid(f, 8, 1), 0) = "-" _
Then f = Replace(f, "(" & x & ")", x)
End If
Next
'classement si + ou *
If f Like "?+?+?+?" Then
f = mini(x1, x2, x3, x4)
f = Mid(f, 1, 1) & "+" & Mid(f, 2, 1) & "+" & Mid(f, 3, 1) & "+" & Mid(f, 4, 1)
End If
If f Like "?[*]?[*]?[*]?" Then
f = mini(x1, x2, x3, x4)
f = Mid(f, 1, 1) & "*" & Mid(f, 2, 1) & "*" & Mid(f, 3, 1) & "*" & Mid(f, 4, 1)
End If
If f Like "(?????)[*]?" And Mid(f, 9, 1) <= Mid(f, 2, 1) Then f = Mid(f, 9, 1) & "*" & Mid(f, 1, 7)
If f Like "?[*](?????)" And Mid(f, 1, 1) > Mid(f, 4, 1) Then f = Mid(f, 3, 7) & "*" & Mid(f, 1, 1)
Epur = f
End Function