Sub Opérateurs_Staple()
Dim op() As Variant, x1, x2, x3, x4, o1, o2, o3 As Byte
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 = "(" & x1 & op(o1) & x2 & ")" & op(o2) & x3 & op(o3) & x4
f2 = x1 & op(o1) & "(" & x2 & op(o2) & x3 & ")" & op(o3) & x4
f3 = "(" & x1 & op(o1) & x2 & ")" & op(o2) & "(" & x3 & op(o3) & x4 & ")"
f4 = "(" & x1 & op(o1) & x2 & op(o2) & x3 & ")" & op(o3) & x4
f5 = x1 & op(o1) & "(" & x2 & op(o2) & x3 & op(o3) & x4 & ")"
If IsError(Evaluate(f1)) Then GoTo 1
If [COLOR="Red"]Abs(Evaluate(f1) - 24) < 10 ^ -13[/COLOR] Then
formule.Add f1
cl = classe(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If
1 If IsError(Evaluate(f2)) Then GoTo 2
If [COLOR="Red"]Abs(Evaluate(f2) - 24) < 10 ^ -13[/COLOR] Then
formule.Add f2
cl = classe(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If
2 If IsError(Evaluate(f3)) Then GoTo 3
If [COLOR="Red"]Abs(Evaluate(f3) - 24) < 10 ^ -13[/COLOR] Then
formule.Add f3
cl = classe(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If
3 If IsError(Evaluate(f4)) Then GoTo 4
If [COLOR="Red"]Abs(Evaluate(f4) - 24) < 10 ^ -13[/COLOR] Then
formule.Add f4
cl = classe(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If
4 If IsError(Evaluate(f5)) Then GoTo 5
If [COLOR="Red"]Abs(Evaluate(f5) - 24) < 10 ^ -13[/COLOR] Then
formule.Add f5
cl = classe(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If
5 Next
Next
Next
Next
Next
Next
Next
MsgBox "Formules " & formule.Count
MsgBox "Combinaisons " & combinaison.Count
End Sub
Function classe(x1, x2, x3, x4)
y1 = 1 * (x1 & x2 & x3 & x4)
y2 = 1 * (x1 & x2 & x4 & x3)
y3 = 1 * (x1 & x3 & x2 & x4)
y4 = 1 * (x1 & x3 & x4 & x2)
y5 = 1 * (x1 & x4 & x2 & x3)
y6 = 1 * (x1 & x4 & x3 & x2)
y7 = 1 * (x2 & x1 & x3 & x4)
y8 = 1 * (x2 & x1 & x4 & x3)
y9 = 1 * (x2 & x3 & x1 & x4)
y10 = 1 * (x2 & x3 & x4 & x1)
y11 = 1 * (x2 & x4 & x1 & x3)
y12 = 1 * (x2 & x4 & x3 & x1)
y13 = 1 * (x3 & x1 & x2 & x4)
y14 = 1 * (x3 & x1 & x4 & x2)
y15 = 1 * (x3 & x2 & x1 & x4)
y16 = 1 * (x3 & x2 & x4 & x1)
y17 = 1 * (x3 & x4 & x1 & x2)
y18 = 1 * (x3 & x4 & x2 & x1)
y19 = 1 * (x4 & x1 & x2 & x3)
y20 = 1 * (x4 & x1 & x3 & x2)
y21 = 1 * (x4 & x2 & x1 & x3)
y22 = 1 * (x4 & x2 & x3 & x1)
y23 = 1 * (x4 & x3 & x1 & x2)
y24 = 1 * (x4 & x3 & x2 & x1)
classe = Application.Min(y1, y2, y3, y4, y5, y6, y7, y8, y9, y10, y11, y12, y13, y14, y15, y16, y17, y18, y19, y20, y21, y22, y23, y24)
End Function
Sub Opérateurs_Staple()
Dim op() As Variant, x1, x2, x3, x4, o1, o2, o3 As Byte
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 = "(" & x1 & op(o1) & x2 & ")" & op(o2) & x3 & op(o3) & x4
f2 = x1 & op(o1) & "(" & x2 & op(o2) & x3 & ")" & op(o3) & x4
f3 = "(" & x1 & op(o1) & x2 & ")" & op(o2) & "(" & x3 & op(o3) & x4 & ")"
f4 = "(" & x1 & op(o1) & x2 & op(o2) & x3 & ")" & op(o3) & x4
f5 = 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
formule.Add f1
cl = mini(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If
1 If IsError(Evaluate(f2)) Then GoTo 2
If Abs(Evaluate(f2) - 24) < 10 ^ -13 Then
formule.Add f2
cl = mini(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If
2 If IsError(Evaluate(f3)) Then GoTo 3
If Abs(Evaluate(f3) - 24) < 10 ^ -13 Then
formule.Add f3
cl = mini(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If
3 If IsError(Evaluate(f4)) Then GoTo 4
If Abs(Evaluate(f4) - 24) < 10 ^ -13 Then
formule.Add f4
cl = mini(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
End If
4 If IsError(Evaluate(f5)) Then GoTo 5
If Abs(Evaluate(f5) - 24) < 10 ^ -13 Then
formule.Add f5
cl = mini(x1, x2, x3, x4)
If Application.CountIf(Range("A:A"), cl) = 0 Then
combinaison.Add cl
Range("A" & combinaison.Count) = cl
End If
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
Sub Opérateurs_Staple()
Dim op() As Variant, x1, x2, x3, x4, o1, o2, o3 As Byte
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 = "(" & x1 & op(o1) & x2 & ")" & op(o2) & x3 & op(o3) & x4
f2 = x1 & op(o1) & "(" & x2 & op(o2) & x3 & ")" & op(o3) & x4
f3 = "(" & x1 & op(o1) & x2 & ")" & op(o2) & "(" & x3 & op(o3) & x4 & ")"
f4 = "(" & x1 & op(o1) & x2 & op(o2) & x3 & ")" & op(o3) & x4
f5 = 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
formule.Add f1
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
On Error GoTo 0
End If
1 If IsError(Evaluate(f2)) Then GoTo 2
If Abs(Evaluate(f2) - 24) < 10 ^ -13 Then
formule.Add f2
cl = mini(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, CStr(cl)
If Err = 0 Then Range("A" & combinaison.Count) = cl
On Error GoTo 0
End If
2 If IsError(Evaluate(f3)) Then GoTo 3
If Abs(Evaluate(f3) - 24) < 10 ^ -13 Then
formule.Add f3
cl = mini(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, CStr(cl)
If Err = 0 Then Range("A" & combinaison.Count) = cl
On Error GoTo 0
End If
3 If IsError(Evaluate(f4)) Then GoTo 4
If Abs(Evaluate(f4) - 24) < 10 ^ -13 Then
formule.Add f4
cl = mini(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, CStr(cl)
If Err = 0 Then Range("A" & combinaison.Count) = cl
On Error GoTo 0
End If
4 If IsError(Evaluate(f5)) Then GoTo 5
If Abs(Evaluate(f5) - 24) < 10 ^ -13 Then
formule.Add f5
cl = mini(x1, x2, x3, x4)
On Error Resume Next
combinaison.Add cl, CStr(cl)
If Err = 0 Then Range("A" & combinaison.Count) = cl
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
Re
Je m'en vais créer deux tableaux de ce pas.
Sub test_ii()
Dim hasard As Long
Dim chiffres
hasard = Int((Rnd * 404) + 1)
MsgBox combinaison.Item(Int((Rnd * 404) + 1))
'Cells(13, 6) = Mid(chiffres, 1, 1)
'Cells(14, 5) = Mid(chiffres, 2, 1)
'Cells(14, 7) = Mid(chiffres, 3, 1)
'Cells(17, 6) = Mid(chiffres, 4, 1)
''solution = tab_formules(hasard)
'V_solution = MsgBox("Voir la solution?", vbYesNo, "Afficher une solution")
'Debug.Print V_solution
'If V_solution = 6 Then
'MsgBox solution & " = 24"
'End If
End Sub
1 If IsError(Evaluate(f2)) Then GoTo 2
If Abs(Evaluate(f2) - 24) < 10 ^ -13 Then
formule.Add f2
cl = DecToHex(mini(x1, x2, x3, x4))
On Error Resume Next
combinaison.Add cl, CStr(cl)
Public Function DecToHex(DecVal As Double) As String
Dim a As Double, b As Double, c As String, d As Double
a = DecVal
For b = 1 To Int(Log(DecVal) / Log(16)) + 1
d = CDbl(a Mod 16)
Select Case d
Case 0 To 9
c = d
Case Else
c = Chr(55 + d)
End Select
DecToHex = c & DecToHex
a = CDbl(Int(a / 16))
Next b
End Function