Controle du tirage

bonjour à tous,

Pour le sujet suivant mon niveau de niveau de VBA est dépassé.

je souhaiterai controler les tirages de on concours pour que les équipes ne se rencontre pas 2 fois sur les 4 parties.

je souhaiterai que le vba me mette en couleur les équipes qui se sont rencontrés. Voir le fichier joint.

attention je peux avoir dans le tirage partie 1 : 3 contre le 13 et dans le tirage partie 2 : 13 contre le 3

maxi 4 parties ou tirages et maxi 50 rencontres

merci de votre aide

cordialement

philippe

Hello,

Une proposition, je n'aime pas le chicoss donc ce n'est pas la + chic qu'on puisse faire ...

Je te laisse te faire les dents (de loup ) sur ton fichier pour mettre une couleur différente pour chaque doublon de tirage

bonjour Rag02700

merci pour ta réponse, ca me convient trés bien mais j'ai un soucis il me donne le 3 contre le 23 dans la 3éme rencontre, celà vient du faites que dans la 2éme partie ils sont l'un sous l'autre mais ils sont dans 2 rencontres différent le 20 contre le 23 et le 3 contre le 32 . Y a t'il un moyen de corriger ça?

ci joint le fichier avec l'exemple

cordialment

philippe

bonjour,

une autre proposition à tester (avec mise en page un peu différente)

bonjour H2so4

merci pour aide, mais tout mon fichier est finit à par ce probléme sur le controle des rencontres.

j'espere que Rag02700 pourra le résoudre, ou un autre membre

merci à tous pour votre aide

philippe

Hello à tous,

J'ai fait le Feignant jusqu'au bout

Essaye comme ceci :

Sub Rencontre()
    'L'idée de ce code est de créer une clef unique dans la colonne AA par rencontre
    'je concatene le premier numéro avec le deuxieme
    'Puis la même façon mais à l'envers, le deuxieme avec le premier
    'Une fois que s'est fait, je compte les clefs et si elles y sont + d'une fois chacune, je coloris
    Dim bytTirage                As Byte
    Dim bytColTirage             As Byte
    Dim bytDerLigTirage          As Byte
    Dim bytNumTirage             As Byte
    Dim intSynthese              As Integer
    Dim strClef                  As String
    Dim strClefreverse           As String
    Dim intCptEqui               As Integer

    Range("AA:AA").Clear
    bytColTirage = 2
    intSynthese = 3
    intCptEqui = 1000
    For bytTirage = 1 To 4
        bytDerLigTirage = Cells(Rows.Count, bytColTirage).End(xlUp).Row
        For bytNumTirage = 3 To bytDerLigTirage Step 2
            strClef = Cells(bytNumTirage, bytColTirage)
            strClefreverse = Cells(bytNumTirage + 1, bytColTirage)
            If (strClef & strClefreverse) = (strClefreverse & strClef) Then
                strClef = strClef + intCptEqui
                intCptEqui = intCptEqui + 1
                strClefreverse = strClefreverse + intCptEqui
                intCptEqui = intCptEqui + 1
            End If
            Cells(intSynthese, "AA") = strClef & strClefreverse
            intSynthese = intSynthese + 1
            Cells(intSynthese, "AA") = strClefreverse & strClef
            intSynthese = intSynthese + 1
        Next bytNumTirage
        bytColTirage = bytColTirage + 5
    Next bytTirage

    bytColTirage = 2
    intSynthese = 3
    For bytTirage = 1 To 4
        bytDerLigTirage = Cells(Rows.Count, bytColTirage).End(xlUp).Row
        For bytNumTirage = 3 To bytDerLigTirage Step 2
            strClef = Cells(bytNumTirage, bytColTirage) & Cells(bytNumTirage + 1, bytColTirage)
            strClefreverse = Cells(bytNumTirage + 1, bytColTirage) & Cells(bytNumTirage, bytColTirage)
            If Application.WorksheetFunction.CountIf(Range("AA:AA"), strClef) > 1 And _
                Application.WorksheetFunction.CountIf(Range("AA:AA"), strClefreverse) > 1 Then
                Union(Cells(bytNumTirage, bytColTirage), Cells(bytNumTirage + 1, bytColTirage)).Interior.ColorIndex = 20
            End If
        Next bytNumTirage
        bytColTirage = bytColTirage + 5
    Next bytTirage

    Range("AA:AA").Clear

End Sub