Sub Tirages()
Dim t, ntirages&, d As Object, tablo, i&, x$, y$, z$, n&
t = Timer
ntirages = 100000 'nombre maximum de tirages, à adapter
Application.ScreenUpdating = False
'---liste des arrangements---
Range("C2:F" & Rows.Count).ClearContents 'RAZ
Set d = CreateObject("Scripting.Dictionary")
tablo = [A2:A144]
For i = 1 To 143
x = Left(tablo(i, 1), 1)
y = Mid(tablo(i, 1), 2, 1)
z = Right(tablo(i, 1), 1)
d(x & " " & y & " " & z) = ""
d(x & " " & z & " " & y) = ""
d(y & " " & x & " " & z) = ""
d(y & " " & z & " " & x) = ""
d(z & " " & x & " " & y) = ""
d(z & " " & y & " " & x) = ""
Next
[D2].Resize(d.Count) = Application.Transpose(d.Keys)
[D2].Resize(d.Count).TextToColumns [D2], xlDelimited, Space:=True 'commande Convertir
[C2].Resize(d.Count) = "=RAND()"
'---tris aléatoires---
[M2:O144].ClearContents 'RAZ
With [C1].CurrentRegion.Resize(, 4)
For n = 1 To ntirages
If n Mod 100 = 0 Then Application.StatusBar = Format(n, "#,##0") & " tirages" 'pour faire patienter...
.Sort .Columns(1), Header:=xlYes
If Application.Max(Range("I2:K13")) <= 14 Then
[M2:O144] = [D2:F144].Value
Application.ScreenUpdating = True
MsgBox Format(n, "#,##0") & " tirages réalisés en " & Format(Timer - t, "0.0") & " secondes", , "143 arrangements trouvés"
Exit Sub
End If
Next n
End With
MsgBox "Aucun résultat en " & Format(ntirages, "#,##0") & " tirages..."
End Sub