XL 2019 Problème de "podium" (classement des scores)

[cganimateur]

Bonjour tout le monde !

Je reviens avec mon fichier de gestion de concours de tarot. Maintenant que après des semaines de recherche, les rotation de mon fichier fonctionnent à merveille. Cependant, j'ai un soucis avec ma feuille "CLASSEMENT" , il ne prends pas les scores de tous les joueurs ! Même l'ia ne me solutionne pas mon problème. je vous koins mon beau fichier en espérant qu'un pro me trouve une solution !
Bonne journée à vous !

 

[klin89]

Re à tous, 🙂

Dans une feuille annexe, j’ai repris les rotations conformément au règlement de la Fédération Française de Tarot (voir fichier du post #42)
Chaque manche se voit attribuer une rotation spécifique pour un nombre de tables donné.
À chaque itération, la macro identifie la rotation correspondant à la manche en cours et l'applique automatiquement.
Le tournoi est limité à 7 manches, à 6 manches pour un tournoi à 8 tables et à 5 manches pour un tournoi à 6 tables.
La macro est dans le module2.

Option Explicit

Sub DeplacementTableV3()
    Dim derLig As Long, i As Long, idx As Long, col As Long
    Dim Arr(), b(), sortieRot()
    Dim debut, decal
    Dim d As Long, nbTables As Long, tour  As Long
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim ligTrouvee As Variant

    Set ws1 = Sheets("Feuil1"): Set ws2 = Sheets("Decalage")
    debut = Array(2, 3, 4)

    With ws1
        derLig = .Cells(Rows.Count, "B").End(xlUp).Row
        'derLig = 25
        ' Calcul du nombre de tables
        nbTables = (derLig - 1) \ 4
        
        For col = 3 To 8
            ' Numéro du tour
            tour = col - 1

            ' Recherche ligne correspondante dans la feuille "Decalage"
            ligTrouvee = Application.Match( _
                         nbTables & "|" & tour, _
                         ws2.Evaluate("INDEX(A2:A124&""|""&B2:B124,)"), _
                         0)

            If IsError(ligTrouvee) Then
                MsgBox "Correspondance non trouvée pour :" & vbCrLf & _
                       "Tables = " & nbTables & vbCrLf & _
                       "Tour = " & tour, vbCritical
                Exit Sub
            End If
            
            ligTrouvee = ligTrouvee + 1
            ' Lecture dynamique des décalages
            decal = Array( _
                    ws2.Cells(ligTrouvee, 3).Value, _
                    ws2.Cells(ligTrouvee, 4).Value, _
                    ws2.Cells(ligTrouvee, 5).Value)


            ' Charger 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

            ' Écriture
            .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

klin89