Option Explicit
Dim oWs As Worksheet
Sub NAleaAll_Param()
Dim bcl As Long, dep As Long, pas As Long, i As Long, x As Long, fin As Long
Set oWs = ActiveSheet
oWs.Cells.ClearContents
dep = Application.InputBox(prompt:="Chiffre de départ ?", Type:=1, Default:=10)
If dep = 0 Then Exit Sub
fin = Application.InputBox(prompt:="Chiffre de fin ?", Type:=1, Default:=25)
If fin = 0 Then Exit Sub
If fin < dep Then Exit Sub
pas = Application.InputBox(prompt:="Pas des essais suivants ?", Type:=1, Default:=5)
If pas = 0 And fin <> dep Then
MsgBox "La fin ne sera jamais atteinte"
Exit Sub
End If
bcl = Application.InputBox(prompt:="Combien de boucles ?", Type:=1, Default:=3)
If bcl = 0 Then Exit Sub
i = 1
x = dep
Do While i <= bcl
Do While x <= fin
Call NAleaAll(x)
x = x + pas
Loop
i = i + 1
x = dep
Loop
Set oWs = Nothing
End Sub
Sub NAleaAll_Single()
Set oWs = ActiveSheet
oWs.Columns(1).ClearContents
Call NAleaAll
Set oWs = Nothing
End Sub
Private Sub NAleaAll(Optional ByVal x)
Dim rw As Long, cpt As Long, i As Long, b As Boolean
Dim MyTab() As Long, vTim As Double, n As Long
If IsMissing(x) Then x = Application.InputBox(prompt:="Nombre a atteindre ?", Type:=1, Default:=10)
If x = 0 Then Exit Sub
rw = 1 'ligne
cpt = 1 'compteur
vTim = Now
oWs.Columns(1).ClearContents
Do While cpt < x
'nombre aléatoire
Randomize
oWs.Cells(rw, 1) = Int(x * Rnd) + 1
oWs.Cells(rw, 1).Copy
oWs.Cells(rw, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
If rw = 1 Then
'cas particulier 1ère écriture
ReDim MyTab(1 To cpt)
MyTab(cpt) = oWs.Cells(rw, 1)
Else
'sinon
For i = 1 To cpt
b = True
If oWs.Cells(rw, 1) = MyTab(i) Then
'déjà sorti
b = False
Exit For
End If
Next i
'nouveau
If b = True Then
cpt = cpt + 1
ReDim Preserve MyTab(1 To cpt)
MyTab(cpt) = oWs.Cells(rw, 1)
End If
End If
rw = rw + 1
Loop
n = Int((Now - vTim) * 86400) + 1
i = 2
Do While oWs.Cells(x, i) <> ""
i = i + 1
Loop
oWs.Cells(x, i) = rw & " tir, " & n & " s"
End Sub
