Re : Etude du loto (Celle de l'Euromillion?)
Bonjour le forum et bonjour Fliptrick
Je ne comprends pas ce que tu veux faire.
Voici 3 macros pour t'aider.
Macro triplets
Sub Loto()
Dim Num1 As Byte
Dim Num2 As Byte
Dim Num3 As Byte
Dim NbreNum As Byte
Dim L As Long, C As Byte
Dim T#
T = Timer
L = 1
C = 0
Application.ScreenUpdating = False
NbreNum = 20 'Nombre de partants au PMU ou 50 pour Euromillion ou 49
For Num1 = 1 To NbreNum
For Num2 = Num1 + 1 To NbreNum
For Num3 = Num2 + 1 To NbreNum
Cells(L, 1 + C) = Num1 & ";" & Num2 & ";" & Num3
L = L + 1
If L = 301 Then
C = C + 1
L = 1
End If
Next Num3
Next Num2
Next Num1
Application.ScreenUpdating = True
MsgBox Format((300 * C) + L, "#,##0") & " Combinaisons calculées en " & Format(Timer - T, "0.00") & " secondes."
End Sub
Macro recherchant une combine
Sub EAssociations()
Application.Calculation = xlManual
Fétiche = Array(7, 21, 23, 24, 44) 'à changer par ta combine recherchée ou fétiche
Range("ZoneE").Font.ColorIndex = xlAutomatic
For li = 2 To Cells(2 ^ 16, 1).End(xlUp).Row
For co = 5 To 9
For i = 0 To 4
If Fétiche(i) = Cells(li, co) Then
Cells(li, co).Font.ColorIndex = 5
End If
Next i
Next co
For i = 5 To 9
If Cells(li, i).Font.ColorIndex = 5 Then bleu = bleu + 1
Next i
Cells(li, 13) = bleu: bleu = 0
Next li
Application.Calculation = xlAutomatic
End Sub
Macro identifiant les triplets et doublés des tirages passés
Sub EAdjacents()
' Adjacents Macro
' Recherche les adjacents
' Macro enregistrée le 26/04/2008 par François
Range("ZoneE").Font.ColorIndex = xlAutomatic
For li = 2 To Cells(2 ^ 16, 1).End(xlUp).Row
For co1 = 5 To 9
For co2 = 6 To 9
If Cells(li, co2) = Cells(li, co1) + 1 Then
Cells(li, co1).Font.ColorIndex = 3
Cells(li, co2).Font.ColorIndex = 3
End If
Next co2
Next co1
For i = 5 To 9
If Cells(li, i).Font.ColorIndex = 3 Then rouge = rouge + 1
Next i
Cells(li, 12) = rouge: rouge = 0
Next li
End Sub
Macro pour trier les adjacents car il faut un ordre croissant.
Sub Macro1()
' Macro1 Macro trier les lignes
For i = 2 To 225
'
Range("A" & i & ":" & "G" & i).Select
Selection.Sort Key1:=Range("A" & i), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Next i
End Sub
Je ne comprends pas et je vois que Soenda aussi.....
esperant que cela te serviras.
à ta disposition dans la mesure ou je sais faire et ou je comprends ta demande.
a+
Michel