XL 2021 tirage au sort aléatoire sans doublon

For i = 1 To NbTirages
        Do
            Tirage = Int((Max - Min + 1) * Rnd + Min)
            nbtours = nbtours + 1
        Loop Until Not dico.Exists(Tirage)
        
        dico.Add Tirage, Tirage
    Next i

Sub test()
    'auteur:     patricktoulon
    Dim Matrice, index&, index2&, memo&
    Matrice = [ROW(1:40)]
    For index = 1 To UBound(Matrice)
        index2 = 1 + (Rnd * (UBound(Matrice) - 1))
        memo = Matrice(index, 1)
        Matrice(index, 1) = Matrice(index2, 1)
        Matrice(index2, 1) = memo
        nbtours = nbtours + 1
    Next
    Range("C3").Resize(UBound(Matrice), 1).Value = Matrice
    MsgBox nbtours & " tours de boucle dans le moulin sans doublons avec une seule boucle et sans dico sans transposition "
End Sub

Public Sub Désordre()
Rem. Méthode. Change aléatoirement l'ordre des numéros.
   Dim P As Long, R As Long, J As Long
   Rem. Algorithme du mélange de Fisher-Yates.
   For P = PMax To 2 Step -1
      R = Int(Rnd * P) + 1: J = Joueur(R): Joueur(R) = Joueur(P): Joueur(P) = J
      Next P
   RectifierPositions
   End Sub

Option Explicit
Public Tirage() As Long
Sub Tirages()
    Dim TDon(), TNoms() As String, TRésu(), M As Long, L As Integer, C As Integer, LMax As Long, MMax As Long, J As Long, Wsh As Worksheet
  Dim T#
  T = Timer
   ImageRoueTourne
' Récupération des inscrits
   TDon = WshT1.[A3:B3].Resize(WshT1.Cells(2 ^ 20, "A").End(xlUp).Row - 2).Value
   ReDim TNoms(1 To UBound(TDon))
   For L = 1 To UBound(TNoms)
      TNoms(TDon(L, 1)) = TDon(L, 2)
      Next L
' Tirage
   If Tirage1vs1OK(NbJrs:=UBound(TNoms), Manches:=2) Then
   Rem. ——— Versement du tableau Tirage vers un tableau de valeurs de cellules.
      MMax = UBound(Tirage, 1) ' Nombre de tours
      LMax = UBound(Tirage, 2) ' Nombre de lignes de rencontres.
      ReDim TRésu(1 To LMax * 2, 1 To 2)
      For M = 1 To MMax
            For L = 1 To LMax
               For C = 1 To 2
                  J = Tirage(M, L, C)
                  If J <> 0 Then
                     TRésu(2 * (L - 1) + C, 1) = J: TRésu(2 * (L - 1) + C, 2) = TNoms(J)
                  Else
                     TRésu(2 * (L - 1) + C, 1) = Empty: TRésu(2 * (L - 1) + C, 2) = Empty
                     End If: Next C, L
         Set Wsh = Worksheets(M)
         Wsh.[A3].Resize(UBound(TRésu, 1), 2).Value = TRésu
         Next M
      End If
    MsgBox Timer - T
    'on place le msgbox avant l'affichage du userform pour ne pas compter celui ci et que le message s'affiche juste avant et non bloquant (pour afficher les deux
    
  ImageRoueFixe
   End Sub

=EditDurée(A1)

Option Explicit
Public Function EditDurée(ByVal T As Double) As String
   Dim S() As String, M As Double, E As Long
   Select Case T
      Case Is < 10: S = Split(Format(T, "000.E+00"), "E"): E = S(1) \ 3: M = S(0) * 10 ^ S(1) * 1000 ^ -E
                     EditDurée = Choose(1 - E, "Dénoué", "Réglé", "Aperçu") & " en " _
         & M & " " & Choose(1 - E, "", "milli", "micro") & "seconde" & IIf(M > 1, "s", "") & "."
      Case Is < 60:  EditDurée = "Dépêtré en " & Int(T * 10 + 0.5) / 10 & " secondes" & "."
      Case Else:     EditDurée = "Achevé en " & DuréeEnClairSec(T) & "."
      End Select
   End Function
Private Function DuréeEnClairSec(ByVal DuRest As Double) As String
   Dim U As Long, DuUnit As Double, NbUnit As Long, Niv As Long, Trad As String
   For U = 1 To 7
      DuUnit = Choose(U, 31556952, 2629746, 604800, 86400, 3600, 60, 1)
      NbUnit = Int(DuRest / DuUnit)
      If NbUnit > 0 Or Niv > 0 Then Niv = Niv + 1: If Niv > 2 Then Exit Function
      If NbUnit > 0 Then
         Trad = NbUnit & " " & Choose(U, "an", "mois", "semaine", "jour", "heure", "minute", "seconde")
         If NbUnit * Choose(U, 1, 0, 1, 1, 1, 1, 1) > 1 Then Trad = Trad & "s"
         If Niv = 2 Then DuréeEnClairSec = DuréeEnClairSec & " et "
         DuréeEnClairSec = DuréeEnClairSec & Trad: End If
      DuRest = DuRest - DuUnit * NbUnit: Next U
   End Function