XL 2016 Modifier ou créer une macro de tri aléatoire par équipe de trois joueurs en lui ajoutant une colonne

berru76

XLDnaute Occasionnel
Bonjour

J'ai une macro de tri par équipes (merci a son auteur Dranreb)
J'aimerais pouvoir lui intégrer "si cela est possible" les valeurs de la colonne D
comme dans l'exemple ci joint

Merci de votre aide

------------
Sub TriParÉquipes()
DéclasserGroupesDe3 [C4:C99]
Dim wsh As Worksheet

End Sub
---------------------------------
Sub DéclasserGroupesDe3(ByVal rng As Range)
Dim TEntrée(), TSortie(), n As Long, LE As Long, LS As Long, dl As Long, C As Long
TEntrée = rng.Value
ReDim TSortie(1 To UBound(TEntrée, 1), 1 To 1)
With New ListeAléat
Randomize
.Init UBound(TEntrée, 1) \ 3
For n = 1 To .Count
LE = 3 * (n - 1): LS = 3 * (.Aléat(n) - 1)
For dl = 1 To 3: TSortie(LS + dl, 1) = TEntrée(LE + dl, 1): Next dl
Next n
End With
rng.Value = TSortie
Dim dlg&: dlg = Cells(Rows.Count, 3).End(3).Row: If dlg < 4 Then Exit Sub
Dim Tbl, plg As Range, lg1&, lg2&: lg2 = 4: Application.ScreenUpdating = 0
Set plg = Range("C4:C" & dlg): Tbl = plg: plg.ClearContents: dlg = dlg - 3
For lg1 = 1 To dlg
If Tbl(lg1, 1) <> "" Then Cells(lg2, 3) = Tbl(lg1, 1): lg2 = lg2 + 1
Next lg1
End Sub
 

Pièces jointes

  • Concours trio.xlsm
    120.7 KB · Affichages: 2
Solution
Bonsoir.
Vous pouvez l'écrire comme ça par exemple :
VB:
Sub TriParÉquipes()
   DéclasserGroupesDe3 [C4:D4]
   End Sub
Sub DéclasserGroupesDe3(ByVal Rng As Range)
   Dim TEntrée(), TSortie(), N As Long, LE As Long, LS As Long, dL As Long, C As Long
   Set Rng = Rng.Resize(Rng(10000, 1).End(xlUp).Row - Rng.Row + 1)
   TEntrée = Rng.Value
   ReDim TSortie(1 To UBound(TEntrée, 1), 1 To UBound(TEntrée, 2))
   With New ListeAléat
      Randomize
      .Init UBound(TEntrée, 1) \ 3
      For N = 1 To .Count
         LE = 3 * (N - 1): LS = 3 * (.Aléat(N) - 1)
         For dL = 1 To 3: For C = 1 To UBound(TEntrée, 2)
            TSortie(LS + dL, C) = TEntrée(LE + dL, C)
            Next C, dL, N
      End With
   Rng.Value = TSortie
   End Sub

Dranreb

XLDnaute Barbatruc
Bonsoir.
Vous pouvez l'écrire comme ça par exemple :
VB:
Sub TriParÉquipes()
   DéclasserGroupesDe3 [C4:D4]
   End Sub
Sub DéclasserGroupesDe3(ByVal Rng As Range)
   Dim TEntrée(), TSortie(), N As Long, LE As Long, LS As Long, dL As Long, C As Long
   Set Rng = Rng.Resize(Rng(10000, 1).End(xlUp).Row - Rng.Row + 1)
   TEntrée = Rng.Value
   ReDim TSortie(1 To UBound(TEntrée, 1), 1 To UBound(TEntrée, 2))
   With New ListeAléat
      Randomize
      .Init UBound(TEntrée, 1) \ 3
      For N = 1 To .Count
         LE = 3 * (N - 1): LS = 3 * (.Aléat(N) - 1)
         For dL = 1 To 3: For C = 1 To UBound(TEntrée, 2)
            TSortie(LS + dL, C) = TEntrée(LE + dL, C)
            Next C, dL, N
      End With
   Rng.Value = TSortie
   End Sub
 

Discussions similaires