tirage aléatoire

=INDEX($A:$A;EQUIV(MAX(SI(GAUCHE(Tableau1[Listes des Equipes])=DROITE(D1);Tableau1[ALEA]));$B:$B;0))

=SIERREUR(INDEX($A:$A;EQUIV(GRANDE.VALEUR(SI(GAUCHE(Tableau1[Listes des Equipes])=DROITE(D$1);Tableau1[ALEA]);LIGNE()-1);$B:$B;0));"")

=SIERREUR(INDEX($A:$A;EQUIV(GRANDE.VALEUR(SI(GAUCHE(Tableau1[[Listes des Equipes]:[Listes des Equipes]])=DROITE(D$1);Tableau1[[ALEA]:[ALEA]]);LIGNE()-1);$B:$B;0));"")

=SIERREUR(INDEX($A:$A;EQUIV(GRANDE.VALEUR(SI(GAUCHE(Equipes)=DROITE(D$1);ALEA);LIGNE()-1);$B:$B;0));"")

Sub Tirages()
Dim tablo, dest As Range, ncol%, col%, crit$, a(), b(), n&, i&
tablo = [Tableau1].Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
Set dest = [C1]
ncol = 3
Randomize
For col = 1 To ncol
    crit = Right(dest(1, col), 1)
    Erase a: Erase b 'RAZ
    n = 0
    For i = 1 To UBound(tablo)
        If Left(tablo(i, 1), 1) = crit Then
            ReDim Preserve a(n): a(n) = Rnd 'nombre aléatoire
            ReDim Preserve b(n): b(n) = tablo(i, 1)
            n = n + 1
        End If
    Next i
    If n Then tri a, b, 0, n - 1
    '---restitution---
    With dest(2, col)
        If n Then .Resize(n) = Application.Transpose(b) 'Transpose est limitée à 65536 lignes
        .Offset(n).Resize(Rows.Count - n - .Row + 1).ClearContents 'RAZ en dessous
    End With
Next col
End Sub

Sub tri(a, b, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      temp = b(g): b(g) = b(d): b(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, b, g, droi)
If gauc < d Then Call tri(a, b, gauc, d)
End Sub

=SIERREUR(INDEX($A:$A;EQUIV(GRANDE.VALEUR(SI(GAUCHE($A$1:$A$999)=DROITE(D$1);$B$1:$B$999);LIGNE()-1);$B:$B;0));"")

Sub Tirages()
Dim dest As Range, ncol%, col%, crit$, n, a(), i&, b
Set dest = [C1]
ncol = 3
Application.ScreenUpdating = False
dest(2).Resize(Rows.Count - dest.Row, ncol).ClearContents 'RAZ
Randomize
With [Tableau1].ListObject.Range 'tableau structuré
    .Sort .Columns(1), xlAscending, Header:=xlYes 'tri du tableau
    For col = 1 To ncol
        crit = Right(dest(1, col), 1) & "*"
        n = Application.CountIf(.Columns(1), crit)
        If n Then
            ReDim a(1 To n)
            For i = 1 To n: a(i) = Rnd: Next i 'nombres aléatoires
            b = .Cells(Application.Match(crit, .Columns(1), 0), 1).Resize(n, 2) 'au moins 2 éléments
            tri a, b, 1, n
            dest(2, col).Resize(n) = b 'restitution
        End If
    Next col
End With
End Sub

Sub tri(a, b, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      temp = b(g, 1): b(g, 1) = b(d, 1): b(d, 1) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, b, g, droi)
If gauc < d Then Call tri(a, b, gauc, d)
End Sub

Sub tirageBS()
     Dim aA, aB, aC, Ptr(1 To 3), t0, t1, t2, i, j, s, r
     t0 = Timer
     aA = Range("tableau1").Value
     ReDim aB(1 To UBound(aA), 1 To 3)
     For i = 1 To UBound(aA)
          s = UCase(Left(aA(i, 1), 1))
          Select Case s
               Case "A", "B", "C"
                    j = Asc(s) - 64
                    Ptr(j) = Ptr(j) + 1
                    aB(Ptr(j), j) = aA(i, 1)
          End Select
     Next

     ReDim aC(1 To Application.Max(Ptr), 1 To 3)
     For j = 1 To 3
          For i = Ptr(j) To 1 Step -1
               r = WorksheetFunction.RandBetween(1, i)
               aC(i, j) = aB(r, j)
               aB(r, j) = aB(i, j)
          Next
     Next
     t1 = Timer
    
     Range("C2").Resize(UBound(aC), UBound(aC, 2)).Value = aC
     t2 = Timer
    
     MsgBox "triage  : " & Format(t1 - t0, "0.000\s") & vbLf & "Collage : " & Format(t2 - t1, "0.000\s") & vbLf & "Total : " & Format(t2 - t0, "0.000\s")
End Sub