Private Declare Function GetTickCount Lib "kernel32" () As Long
Public formule As New Collection
Public combinaison As New Collection
[COLOR=Blue][B]Public solution As New Collection[/B][/COLOR]
Sub Opérateurs_Staple()
Dim lngStart As Long
Dim lngFinish As Long
Dim temps As Long
Dim Hours As Double
Dim Minutes As Double, Seconds As Double
Dim op() As Variant, x1, x2, x3, x4, o1, o2, o3 As Byte
Dim f1, f2, f3, f4, f5 As String, cl As Double
lngStart = GetTickCount()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
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
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
[COLOR=Blue][B]solution.Add "=" & f1[/B][/COLOR]
End If
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
solution.Add "=" & f2
End If
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
solution.Add "=" & f3
End If
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
solution.Add "=" & f4
End If
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
solution.Add "=" & f5
End If
On Error GoTo 0
End If
5 Next
Next
Next
Next
Next
Next
Next
lngFinish = GetTickCount(): temps = lngFinish - lngStart
temps = temps \ 1000: Hours = temps \ 3600&
If Hours > 0 Then temps = temps - (3600& * Hours)
Minutes = temps \ 60: Seconds = temps Mod 60
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox Format(CStr(Hours & ":" & Minutes & ":" & Seconds), "hh:mm:ss")
End Sub
[COLOR=Blue][B]Sub ok_solution()
hasard = Int((Rnd * 404) + 1) * 1
MsgBox combinaison.Item(hasard)
MsgBox solution.Item(hasard)
End Sub[/B][/COLOR]
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
mini = 1 * mini
End Function