Discussion :

[nlbmoi]

Bonjour

Je fais suite à une demande initiale qui consistait à trouver des doublons dans une feuille et les afficher dans une seconde : la discussion (avec la réponse) est ici.
j'avais testé certains cas mais pas tous les cas et évidemment, il s'avère qu'il y a toujours un cas qu'on ne pensait pas voir qui arrive. Dans le cas où 2 arbitres sont chacun notés sur 2 équipes différentes, la solution proposée n'affiche que la première itération trouvée, la seconde n'étant pas affichée.

Comment dois-je modifier le code pour afficher, lorsque plusieurs arbitres sont indiqués pour plusieurs équipes, les équipes avec un arbitre en doublon dans les colonnes successives à partir de la colonne S ?
Merci

[ARTURO83]

Bonjour,

Je ne comprends pas très bien le sens de la question, des exemples seraient les bienvenus pour une meilleure compréhension.

En attendant, ce que j'ai crû comprendre:
-Si un même arbitre est affecté à plusieurs club, il n'en ressortirait qu'un seul dans la liste. Est-ce bien cela?

Si c'est le cas, j'ai fait des essais et ça fonctionne correctement, donc j'en conclus que ce ne doit pas être ça.
Voici le fichier avec les essais suivants: Ajout pour un même arbitre(ici Arbitre 1) des clubs différents (Club X et club Y) et le tout dans des poules différentes
Pièce jointe 518543

Cdlt

[nlbmoi]

Bonjour,

Désolé mais comme c'était la suite de la demande précédente, il est vrai que je n'ai pas tout redétaillé.
Dans la feuille Arbitre, je note pour chaque équipe engagée (niveau en colonne A, club en colonne B) l'arbitre qui est sensé couvrir les arbitrages (colonne D) sauf que je ne peux pas avoir un même arbitre qui couvre 2 équipes.
La solution qui m'a été proposée (voir lien dans mon premier post) me permet d'afficher dans la feuille DAFA dans la colonne S les équipes qui disposent d'un même arbitre de couverture (sur le fichier joint, j'ai ajouté la macro correspondante au bouton "Trouve doublon"). Cette macro fonctionne très bien pour un même arbitre pour plusieurs équipes dans un même club (dans l'exemple joint, en jaune les 2 cas correspondants) mais pas pour quelques cas particuliers que je viens de découvrir et que je ne pensais pas voir apparaître initialement :
- quand, pour un même club, plusieurs arbitres couvrent chacun plusieurs équipes (dans le fichier l'arbitre D1 couvre la RF et la PNF --> bien affiché ; et l'arbitre D2 couvre la RM et la N3F mais n'est pas affichée par la macro précédente, j'ai rajouté en orange ce qui devrait s'afficher en plus de ce qui est en jaune)
- quand un même arbitre couvre plusieurs équipes mais de plusieurs clubs différents (dans le fichier, l'arbitre AB couvre la PNF du club A et la RF du club B), j'ai rajouté en bleu ce qui devrait s'afficher.

trouve_doublon.xlsm

Sincèrement, le deuxième cas est peu probable et si c'est vraiment trop compliqué à détecter (et à afficher), je le laisserai de côté : le principal étant surtout le 1er cas (plusieurs arbitres couvrant plusieurs équipes au sein d'un même club).
Merci

[ARTURO83]

Bonjour,

Voilà avec toutes les modifications demandées.
Pour le dernier cas de figure, comme le même arbitre est présent sur 2 clubs, le résultat apparaît sur les 2 clubs.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
 
Sub Arbitre_en_double()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f2 As Long
    Dim i As Long, j As Long
    Dim Poule As String, PouleB As String, Club As String
 
 
    Application.ScreenUpdating = False
    Set f1 = Sheets("DAFA")
    Set f2 = Sheets("Arbitre")
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    DerLig_f2 = 69
 
    'Effacement des précédents résultats de la feuille "DAFA"
    f1.Columns("S:Z").ClearContents
 
   '*****************************************************************************************************************
   'Recherche même arbitre, avec les mêmes clubs
 
    'Formules pour trouver les doublons
    f2.Select
    f2.Range("S5:S" & DerLig_f2).FormulaR1C1 = "=RC[-17]&""/""&RC[-15]"
    f2.Range("T5:T" & DerLig_f2).FormulaR1C1 = "=IF(RC[-1]<>""/"",COUNTIF(R4C19:R[-1]C19,RC[-1]),"""")"
    f2.Range("S5:T" & DerLig_f2).Value = f2.Range("S5:T" & DerLig_f2).Value
 
    'Suppressions des résultats sans doublons trouvés
    For i = 5 To DerLig_f2 'To 5 Step -1
        If f2.Cells(i, "T") = 0 Or f2.Cells(i, "T") = "" Then
            f2.Range(f2.Cells(i, "S"), f2.Cells(i, "T")).ClearContents
        End If
    Next i
 
    For j = DerLig_f2 To 5 Step -1
        If f2.Cells(j, "T") <> "" Then 'Si des doublons sont trouvés
            Club = f2.Cells(j, "B")
            Arbitre = f2.Cells(j, "D")
            Poule = f2.Cells(j, "A")
            Nb = f2.Cells(j, "T")
            For i = j - 1 To 5 Step -1 'on boucle autant de fois qu'il y a de doublons pour un même club et arbitre
                If f2.Cells(i, "B") = Club And f2.Cells(i, "D") = Arbitre Then
                    Poule = Poule & "/" & f2.Cells(i, "A")
                    f2.Range(f2.Cells(i, "S"), f2.Cells(i, "T")).ClearContents
                    Nb = Nb - 1
                    If Nb <= 0 Then
                        f2.Cells(i, "U") = Poule
                        Exit For
                    End If
                End If
            Next i
        End If
    Next j
   f2.Columns("S:T").ClearContents 'effacement des précédentes recherches
 
   '*****************************************************************************************************************
   'Recherche même arbitre, avec plusieurs clubs différents
    For i = 5 To DerLig_f2
        Arbitre = f2.Cells(i, "D")
        Club = f2.Cells(i, "B")
        Poule = f2.Cells(i, "A")
        f2.Cells(i, "V") = Poule & "(" & Club & ")"
        With f2.Columns("D")
            Set C = .Find(Arbitre, LookIn:=xlValues, lookat:=xlWhole)
            If Not C Is Nothing Then
                    Pos = C.Address
                Do
                    If Not C Is Nothing Then
                        If Arbitre <> "" And f2.Cells(C.Row, "B") <> Club Then
                            PouleB = f2.Cells(C.Row, "A")
                            f2.Cells(i, "V") = f2.Cells(i, "V") & "/" & PouleB & "(" & f2.Cells(C.Row, "B") & ")"
                        End If
                    End If
                    Set C = .FindNext(C)
                Loop While Not C Is Nothing And C.Address <> Pos
            End If
        End With
    Next i
 
    'Suppression des Clubs uniques
    For i = 5 To DerLig_f2
        If InStr(1, Cells(i, "V"), "/", 1) = 0 Then Cells(i, "V").ClearContents
    Next i
 
    '***************************************************************************************************************
    'Restitution dans la feuille "DAFA"
    'Recopie des valeurs trouvées
    For i = 3 To DerLig_f1
        Col = 19
        With f2.Columns("B")
            Set C = .Find(f1.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
            If Not C Is Nothing Then
                    Pos = C.Address
                Do
                    If Not C Is Nothing Then
                        f1.Cells(i, Col) = f2.Cells(C.Row, "U")
                        If f2.Cells(C.Row, "U") <> "" Then Col = Col + 1
                        If f2.Cells(C.Row, "V") <> "" Then
                            f1.Cells(i, Col) = f2.Cells(C.Row, "V")
                            Col = Col + 1
                        End If
                    End If
                    Set C = .FindNext(C)
                Loop While Not C Is Nothing And C.Address <> Pos
            End If
        End With
    Next i
    f2.Columns("S:V").ClearContents
    f1.Select
    Set C = Nothing
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Le fichier
Pièce jointe 518614

Cdlt