Dim colSimul%, tirage&, ub&, tablo 'mémorise les variables
Private Sub Worksheet_Calculate()
Dim dest As Range, col1%, col2%, derlig&, P As Range, Q As Range, i&, v, j&, n&
Set dest = [Q1]
col1 = 11 'colonne K
col2 = 19 'colonne S
derlig = Cells(Rows.Count, col2).End(xlUp).Row
Application.EnableEvents = False 'désactive les évènements
If derlig < 9 Then dest = "": GoTo 1 'si le tableau source est vide
Set P = Cells(1, col1).Resize(derlig)
Set Q = Cells(1, col2).Resize(derlig)
If colSimul = 0 Or tirage = 1 Then
ub = Evaluate("SUM(ROUND(1000*IF(ISNUMBER(" & Q.Address & ")," & Q.Address & "),0))")
ReDim tablo(1 To ub)
For i = 9 To Q.Count
If IsNumeric(CStr(Q(i))) Then
v = P(i)
For j = 1 To Round(1000 * Q(i))
n = n + 1
tablo(n) = v
Next j
End If
Next i
End If
Randomize
dest = tablo(Application.RandBetween(1, ub)) 'tirage
If colSimul Then
i = Application.Match(dest, P, 0)
Cells(i, colSimul) = Cells(i, colSimul) + 1
End If
1 Application.EnableEvents = True 'réactive les évènements
End Sub
Sub Simulation()
Dim t#, n&
t = Timer
colSimul = 21 'colonne U
n = 50000 'à adapter
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Cells(9, colSimul).Resize(Rows.Count - 8).ClearContents 'RAZ
For tirage = 1 To n
Worksheet_Calculate 'lance la macro
Next
colSimul = 0 'RAZ
tirage = 0
Application.Calculation = xlCalculationAutomatic
MsgBox Format(n, "#,##0") & " tirages en " & Format(Timer - t, "0.00 \sec"), , "Durée"
End Sub