Chiffres aléatoires conditionnés

Option Explicit

Sub NAleaAll()
Dim x As Long, rw As Long, cpt As Long, i As Long, b As Boolean
Dim oWs As Worksheet, MyTab() As Long

    
    Set oWs = ActiveSheet
    x = Application.InputBox(prompt:="Combien de chiffres ?", Type:=1, Default:=10)
    rw = 1 'ligne
    cpt = 1 'compteur
    
    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
    
        Set oWs = Nothing
End Sub

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