Déchiffrage de code

Question

Dans un précédent post, curulis57 m'a tricoté ce code qui fonctionne à merveille. Je l'ai copier en Feuil2 pour ne pas toucher à celui de la Feuil1. Seulement voilà, j'essaies de le comprendre, comme je ne peut pas le suivre avec F8 j'ai bien du mal à m'en sortir... Dans un 1er temps, j'ai balisé les ligne que je ne saisissais pas avec des '****** Question ? directement dans le code de la Feuil2. Quelques bonnes âmes aurait elles la gentillesse de m'aider à comprendre ? Merci de votre aide. Mon fichier joint...

Kit · Answer

Dim xxx =&gt; Définition d'une variable. Range("A2:A" & iRow + 10).Interior.Color = xlNone '************ Pourquoi + 10 ? =&gt; 10 cellules plus bas que irow. ReDim Preserve tDataGR(iEq + 1, iLig) '********** Que veut dire "GR" dans le tableau ? =&gt; tDataGR est le nom du tableau...

ExcelCoreGame · Answer

J'aurais envie de dire... demande à curulis57 nan ECG...

Curulis · Answer

Bonne lecture!

Zut, pas fait attention que tu avais mis le fichier...

pourquoi "P" : les deux colonnes des tableaux 'Poules' et 'EQUIPES' sont en police WINGDINGS 2 : le P = le signe V
iRow + 10 : système boîteux et sûrement insuffisant pour ce que je veux en faire, c-à-d, effacer les couleurs d'un éventuel concours précédent.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim tDataJ, tDataGR()       'J comme Joueurs, GR comme groupes (j'aurais pu mettre P comme poule)
'
If Target.Count > 1 Then Exit Sub
'
Application.EnableEvents = False
'
If Not Intersect(Target, Range("G2:G4")) Is Nothing Then        'si clic dans tableau 'EQUIPES'
    iRow = Target.Row
    Range("G2:G4").Value = ""
    Target = "P"
    iRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("A2:A" & iRow + 10).Interior.Color = xlNone           '+10? pour effacer les couleurs d'un éventuel concours précédent
    For x = 2 To iRow Step Target.Offset(0, 1).Value            'TARGET (le V). OFFSET(0,1) la valeur correspondante au 'V'
        Range("A" & x & ":A" & x + Target.Offset(0, 1).Value - 1).Interior.Color = _
                IIf(Range("A" & x).Offset(Target.Offset(0, 1).Value - 1, 0).Value = "", RGB(255, 190, 0), _
                IIf(Range("A" & x - 1).Interior.Color = RGB(255, 255, 255), RGB(215, 215, 215), xlNone))
        'on colore des groupes de lignes correspondant à l'option du tableau 'EQUIPES' en alternant entre gris et blanc
        'si la dernière ligne de ce groupe est vide (= si le nbre de joueurs n'est pas un multiple parfait de l'option 'EQUIPES')...
        '...on colore le dernier groupe incomplet en orange (joueurs sur le carreau, sans équipe)
    Next
    Range("G1").Select
End If
'
If Not Intersect(Target, Range("C2:C5")) Is Nothing Then        'si clic dans tableau 'POULES'
    iRow = Target.Row
    Range("C2:C5").Value = ""
    Target = "P"
    Range("C1").Select
    '
    iNbJ = Range("A" & Rows.Count).End(xlUp).Row - 1        'nbre de joueurs
    Range("B2:B" & iNbJ + 1).Value = 0                      'mise à zéro de la colonne [B:B] qui sera intégrée dans tDataJ
    tDataJ = Range("A2:B" & iNbJ + 1).Value               'mise en tableau des joueurs et colonne [B:B]
    iEq = Range("G2:G4").Find(what:="P", lookat:=xlWhole).Offset(0, 1).Value        'nbre de joueurs par équipe selon tableau 'EQUIPES'
    iNbEq = Int(iNbJ / iEq)         'nbre d'équipes complètes de iEq joueurs
    '
    iNbEqP = Range("C2:C5").Find(what:="P", lookat:=xlWhole).Offset(0, 1).Value       'nbre d'équipes par poule principale
    iNbEqP1 = Range("C2:C5").Find(what:="P", lookat:=xlWhole).Offset(0, 2).Value      'nbre d'équipes par poule de substitution
    '
    iOK = 0     'indice de faisabilité
    iNbP = Int(iNbEq / iNbEqP)     'nbre de poules principales complètes = int( nbre d'éq. complètes / nbre d'éq. par poule principale)
    For x = iNbP To 0 Step -1       'recherche d'éventuelles poules de substitution...
        iNbP1 = iNbEq - (iNbEqP * x)       'calcule les possibilités de poules de substitution
        'iNbP1 (nbre de poules de substitution
        '... = iNbEq (nbre d'équipes) - (nbre d'équipes complètes pour poule principale * x (boucle) )
        'donc, si le nombre d'équipes ne suffit pas à former uniquement des poules principales,...
        '...la boucle diminue progressivement le nombre de ces poules principales... - (iNbEqP * x)
        '...et calcule si le nbre d'équipes restantes (iNbP1) suffit à former un nbre rond de poules de substitution.
        'si le modulo entre ce nbre d'équipes restantes et le nbre d'équipes exigé pour une poule de substitution = 0 = bingo!
        If iNbP1 Mod iNbEqP1 = 0 Then       '
            'Tirage des poules
            Columns("J:Z").ClearContents        'prépare les colonnes d'affichage des résultats
            For y = 1 To IIf(iNbP1 / iNbEqP1 > 0, 2, 1)     'de 1 à 2, si poules de substitution, ou 1, si uniquement poules principales
                For Z = 1 To IIf(y = 1, x, iNbP1 / iNbEqP1) 'de 1 à x (selon boucle), d'abord les poules pricipales puis poules de sub.
                    iNP1 = 0            'variable de contrôle
                    iNP = iNP + 1       'n° de la poule
                    If iNP > 1 Then iLig = iLig + 1     'index du tableau tDataGR pour insérer une ligne vide entre poules
                    For k = 1 To IIf(y = 1, iNbEqP, iNbEqP1)        'de 1 à nbre d'équipes par poules, d'abord principales puis de sub.
                        iLig = iLig + 1                 'index du tableau tDataGR
                        ReDim Preserve tDataGR(iEq + 1, iLig)   'iEq +1 pour laisser la place à l'en-tête de la poule
                        If iNP1 = 0 Then tDataGR(0, iLig - 1) = "Poule " & iNP      'en-tête de la poule (écrit une seule fois grâce à la varaiable de contrôle)
                        iNP1 = 1
                        Randomize
                        iOK = 0     'variable de contrôle
                        Do          'tirage au sort de l'équipe...
                            iIdx = 1 + Int(Rnd * iNbEq)         '...dans le lot total des équipes (groupes colorés)
                            iIdx1 = 1 + ((iIdx - 1) * iEq)      'on calcule la position du premier du groupe élu
                            If tDataJ(iIdx1, 2) = 0 Then        'si l'équipe n'a pas encore été tirée au sort (indice 2 = colonne [B:B] mise à zéro)
                                For w = 0 To iEq - 1            'on prend tout le groupe en fonction de iEq (tableau 'EQUIPES')
                                    tDataJ(iIdx1 + w, 2) = 1    'indice 2 = 1 => déjà tiré au sort
                                    tDataGR(w + 1, iLig - 1) = tDataJ(iIdx1 + w, 1)     'inscription dans tDataGR
                                Next
                                iOK = 1     'on a trouvé une équipe pas encore choisie => iOK=1
                            End If
                        Loop Until iOK = 1      'on peut passer à l'équipe suivante => NEXT k
                    Next        'poule suivante
                Next        'de poule principale à, peut-être, poule de substitution
            Next
            'affichage des résultats et mise à bonne largeur des colonnes
            Range("J1").Resize(UBound(tDataGR, 2), UBound(tDataGR, 1)).Value = WorksheetFunction.Transpose(tDataGR)
            Columns("J:Z").AutoFit
            '
            'je te laisse décortiquer ceci! C'est le message détaillant les infos joueurs/poules.
            'Bon amusement!
            MsgBox iNbJ & " joueurs forment " & iNbEq & " équipes = " & iNbEq * iEq & " joueurs." & Chr(10) & _
                IIf(iNbJ Mod iEq > 0, IIf(iNbJ Mod iEq = 1, Chr(10) & "Un joueur reste sans équipe!" & _
                Chr(10), Chr(10) & iNbJ Mod iEq & " joueurs restent sans équipe!" & Chr(10)), "") & _
                Chr(10) & IIf(x = 0, "Aucune poule de " & iNbEqP & " équipes", IIf(x = 1, "1 poule de " & iNbEqP & " équipes", x & " poules de " & iNbEqP & " équipes")) & _
                IIf(iNbP1 / iNbEqP1 > 0, " et " & IIf(iNbP1 / iNbEqP1 > 1, iNbP1 / iNbEqP1 & " poules de ", "1 poule de ") & iNbEqP1 & " équipes.", "."), _
                vbInformation, "Tirage des poules"
            Exit For
        End If
    Next
    'si faisabilité impossible...
    If iOK = 0 Then MsgBox "La répartition a échoué!" & Chr(10) & "Veuillez choisir une autre configuration!", vbCritical, "Tirage des poules"
End If
'
Application.EnableEvents = True
'
End Sub

A+

ExcelCoreGame · Answer

Aucun soucis, je n'avais pas regarder le nom du fichier en pièce jointe en fait (notre fameuse pétanque ) donc la question me paraissait bizarre, suffisait de lui demander directement

Je n'ai pas la science infuse et mes codes ne sont pas les meilleurs, j'en apprends moi même en lisant les autres sur le forum

Surtout que si Curulis t'a filé un code qui marche bien c'est tout ce qu'il te fallait

ECG

Kit · Answer

Pour le truc des couleurs avec irow + 10, autant virer les couleurs de toute la colonne non ? Un truc à base de .range("A:A").interior.color = xlcolorindexnone...

Curulis · Answer

...pensais pas que ce +10 à la noix en perturberait autant! Allez, on l'efface, on garde juste iRow, et on en parle plus! Le patron s'occupera du ménage entre deux concours! A+...