XL 2021 Rotation joueurs tarot

klin89 à dit:

Re à tous, 🙂

Pour le fun, une version améliorée dans laquelle le décalage est exprimé en nombre de positions, ce qui conduit au même résultat.
Pour comprendre, d’un point de vue visuel, on peut imaginer les tables de 4 alignées en longueur, les joueurs placés côte à côte plutôt que disposés en cercle.
À chaque tour, le deuxième joueur de chaque table se décale de 4 positions, le troisième de 8 et le quatrième de 12.
Lorsqu’on atteint l’extrémité de la rangée, on revient simplement au début de celle-ci.

Dans le fichier : 12 tables soit 48 joueurs et 20 tours

VB:

Option Explicit

Sub DeplacementTableV2()
    Dim derLig As Long, i As Long, idx As Long, col As Long
    Dim Arr(), b(), sortieRot(), debut, decal, d As Long

    With Sheets("Feuil1")
        debut = Array(2, 3, 4)
        decal = Array(4, 8, 12) 'décalage en nombre de places
        derLig = .Cells(Rows.Count, "B").End(xlUp).Row
      
        For col = 3 To 21 ' 20 tours
            ' Charger la colonne précédente
            Arr = .Range(.Cells(2, col - 1), .Cells(derLig, col - 1)).Value

            ' Construire le tableau en base 0
            ReDim b(0 To UBound(Arr, 1) - 1)
            For i = 1 To UBound(Arr, 1)
                b(i - 1) = Arr(i, 1)
            Next i

            ' Appliquer les rotations
            For idx = 0 To UBound(decal)
                d = debut(idx)
                sortieRot = shiftN(b, decal(idx))
                For i = d To UBound(Arr, 1) Step 4
                    Arr(i, 1) = sortieRot(i - 1)
                Next i
            Next idx

            ' Écrire dans la colonne courante
            .Range(.Cells(2, col), .Cells(derLig, col)).Value = Arr
        Next col
    End With
End Sub

Function shiftN(Arr, ByVal n As Integer) 'mapomme
' rotation circulaire
Dim j&, k&, q&
   ReDim r(LBound(Arr) To UBound(Arr)): n = -n: q = (UBound(Arr) - LBound(Arr) + 1): n = n Mod q
   For j = LBound(Arr) To UBound(Arr): k = IIf(n >= 0, (j + n) Mod q, (q + j + n) Mod q): r(j) = Arr(k): Next j
   shiftN = r
End Function

Edit : Pour plus de lisibilité, j'ai mis des nombres, remplace-les par tes noms.
klin89

Cliquez pour agrandir...