Sub Tirage_couleurs()
Dim t#, Ntirage&, coul, ub%, resu&(), d As Object, tirage&, n%, ca%, maxi%
t = Timer
Ntirage = 100000 'à adapter
coul = Array(3, 44, 6, 8, 4) 'codes couleurs classés par criticité décroissante
ub = UBound(coul)
ReDim resu(ub)
Set d = CreateObject("Scripting.Dictionary")
With [C4:G4] 'à adapter
For tirage = 1 To Ntirage
d.RemoveAll 'RAZ
For n = 1 To .Count - 1
ca = coul(Application.RandBetween(0, ub)) 'couleur aléatoire
d(ca) = d(ca) + 1 'comptage
If tirage = Ntirage Then .Cells(n).Interior.ColorIndex = ca
Next
maxi = Application.Max(d.items)
For n = 0 To ub
If d(coul(n)) = maxi Then
resu(n) = resu(n) + 1
If tirage = Ntirage Then .Cells(.Count).Interior.ColorIndex = coul(n)
Exit For
End If
Next
Next tirage
End With
'---restitution---
For n = 0 To ub
[J4].Offset(n) = resu(ub - n) / Ntirage
Next
MsgBox Format(Ntirage, "#,##0") & " tirages en " & Format(Timer - t, "0.00 \sec"), , "Statistiques"
End Sub