Discussion :

[Nonno 94]

Bonjour le forum,

je viens demander votre aide pour résoudre le problème suivant : établir grâce à une macro la liste des doublons figurant dans un tableau après les avoir identifiés.

Pour illustrer ma demande, je vous joins un fichier exemple.

Je vous remercie pour vos réponses.
Cordialement.

Nonno 94.

[grisan29]

bonjour nonno94
je ne sais pas si c'est ce que tu cherche mais voici une macro qui repère les doublons et les coloris sans les supprimés, la recherche se fait en col A mais facile changer

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub ColoriageDoublons()
  [A:A].Interior.ColorIndex = xlNone
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range("A1", [A65000].End(xlUp))
    If c <> "" Then mondico.Item(c.Value) = mondico.Item(c.Value) + 1
  Next c
  For Each c In Range("A1", [A65000].End(xlUp))
    If mondico.Item(c.Value) > 1 Then c.Interior.ColorIndex = 4
  Next c
End Sub

Pascal

[Nonno 94]

Bonjour Pascal et merci pour la réponse;

malheureusement, elle ne répond pas à ma demande qui est : dresser à partir de la cellule [I13] la liste alphabétique des doublons contenus dans le tableau "D4:H8" et repérés dans le tableau "I4:M8".

Bon après-midi.

Nonno 94.

[boisgontierjacques]

Bonjour,

Liste des doublons en colonne A

Code :

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

1
2
3
4
5
6
7
8
 
Set MonDico = CreateObject("Scripting.Dictionary")
Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In Range([a2], [a65000].End(xlUp))
  If MonDico.exists(c.Value) Then MonDico2.Item(c.Value) = ""
  MonDico.Item(c.Value) = ""
Next c
If MonDico2.Count > 0 Then [E2].Resize(MonDico2.Count, 1) = Application.Transpose(MonDico2.keys)

Jacques Boisgontier

[Nonno 94]

Bonjour et merci d'avoir pris la peine de répondre,

mais malheureusement, votre réponse ne correspond pas à ma demande qui est :

dresser à partir de la cellule [I13] la liste alphabétique des doublons contenus dans le tableau "D4:H8" et repérés dans le tableau "I4:M8"

comme dans le fichier joint.
Peut-être est-ce impossible ?

Désolé.
Cordialement.

Nonno 94.

[ted1057]

bonjour,

j'ai fait quelque chose, je ne sais pas si cela pourra t'aider.
je l'ai incorporer dans module 3

[Nonno 94]

Bonjour ted1057 et merci pour la réponse.

Elle ne répond malheureusement pas à ma demande; à savoir :

dresser à partir de la cellule [I13] la liste alphabétique des doublons contenus dans le tableau "D4:H8" et repérés dans le tableau "I4:M8".

comme je l'ai fait manuellement dans le fichier exemple joint précédemment et que je joins à nouveau.

Cordialement.

Nonno 94.

[parmi]

Bonjour,

La question peut paraître simple, mais elle ne l'est pas pour moi... et ne semble pas l'être pour les autres répondants...
Dans ton exemple, il y a 2 grilles identiques de couleurs différentes.

En D2 et I2, on peut voir le nom Pierre, mais il est aussi en F4 et K4...
Est-ce que ces 2 premiers Pierre sont les doublons que tu recherches parce qu'ils sont situés aux mêmes endroits relatifs ou alors tu veux sortir tous les Pierre des 2 listes ?

Le résultat, tu veux qu'il soit inscrit en I13 vers le bas ou dans une grille de format identique avec les noms aux mêmes endroits relatifs ?!?

[Nonno 94]

Bonjour Parmi et merci de vous intéresser à mon "cas".

Pour répondre à votre question, dans le tableau Rouge, sont identifiés les doublons du tableau Jaune.
Ainsi, Pierre apparaît en I2 et K4 parce que Pierre est un doublon (D2 et F4) dans le tableau Jaune.

Dans cet exemple, Pierre, Anaela et Marie sont des doublons.
Je souhaite en créer la liste alphabétique dans une colonne à partir, par exemple, de la cellule [I13] et vers le bas.
Demande supplémentaire : dans cette liste, les Noms ne peuvent figurer qu'une fois même s'ils apparaissent plus de 2 fois dans le tableau Jaune.

Cordialement.

Nonno 94.

[parmi]

Comme ceci peut-être ?

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
Sub SortirDoublons()
    Dim I As Long, J As Long, nbLignes As Long
    Dim Ligne As Long
    Dim nbOcurrence As Long
 
    Ligne = 13
    nbLignes = Cells(Rows.Count, "I").End(xlUp).Row
    If nbLignes >= 13 Then Range("I13:I" & nbLignes ) = ""
 
    For I = 2 To 6
        For J = 4 To 8
            If Cells(I, J) <> "" Then
                nbOccurrence = Application.WorksheetFunction.CountIf(Range("D2:H6"), Cells(I, J))
                If nbOccurrence > 1 Then
                    If Not IsInList(Cells(I, J)) Then  ' vérifier que le nom n'est pas déjà inscrit
                        Range("I" & Ligne) = Cells(I, J)
                        Ligne = Ligne + 1
                    End If
                End If
            End If
        Next
    Next
End Sub
 
Function IsInList(Nom As String) As Boolean
    Dim I As Long, nbLIgnes As Long
 
    nbLIgnes = Cells(Rows.Count, "I").End(xlUp).Row
    If nbLIgnes < 13 Then Exit Function
 
    For I = 13 To nbLIgnes
        If Range("I" & I) = Nom Then
            IsInList = True
            Exit Function
        End If
    Next
End Function

[Nonno 94]

Bonjour parmi et merci pour votre nouvelle proposition.

Elle répond parfaitement à ma demande mais je ne parviens pas à l'adapter à la feuille "Palmarès" du fichier joint alors qu'elle fonctionne parfaitement avec la feuille "Tableau(2)".
En effet, dans la liste établie pour la feuille "Palmarès", il manque, pour une raison que je ne parviens pas à découvrir, les 4 valeurs suivantes : AXA, CLUB MEDITERRA, SODEXO et TELEPERFORMANC.

Pouvez-vous à l'aide du fichier joint me dire ce qui "cloche" chez moi ?

Remerciements et bonne journée.

Nonno 94.

[parmi]

Je pense que tu as mélangé les Functions IsInList et IsInList_Palmarès

Une solution: ajoute un paramètre à IsInList pour le début de la série et utilise uniquement celle-ci.

Dans la procédure SortirDoublons_Palmarès

Code :

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

1
2
If nbOccurrence > 1 Then
    If Not IsInList(Cells(I, J), 33) Then

Et dans celle-ci, quelques modifications

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Function IsInList(Nom As String, Départ As Long) As Boolean
    Dim I As Long, nbLignes As Long
 
    nbLignes = Cells(Rows.Count, "I").End(xlUp).Row
    If nbLignes < Départ Then Exit Function
 
    For I = Départ To nbLignes
        If Range("I" & I) = Nom Then
            IsInList = True
            Exit Function
        End If
    Next
End Function

Et tu pourrais, au besoin, ajouter le nombre d'occurrences en colonne J

Code :

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

1
2
3
4
5
If Not IsInList(Cells(I, J), 33) Then ' vérifier que le nom n'est pas déjà inscrit
     Range("I" & Ligne) = Cells(I, J)
     Range("J" & Ligne) = nbOccurrence
      Ligne = Ligne + 1
End If

Et assure-toi que tous les noms de variables sont bien écrits partout.
J'avais fait une faute d'orthographe avec le nom de variable nbOccurrence (il manquait un "c")

Autre conseil: mets toujours Option Explicit en entête de module (feuille, module de classe ou standard)
Va dans le menu Outils / Options et coche Déclaration des variables obligatoire
Tu peux aussi décocher Vérification automatique de la syntaxe qui peut rendre fou

[Nonno 94]

Re-Bonjour,

j'ai apporté les modifications indiquées et "ça marche trop bien" !
Alors BRAVO et pour ces codes qui vont me permettre de poursuivre la "mise au point" de mon fichier.

Seule ombre au tableau (de ma responsabilité bien entendu) : je ne trouve pas où cocher "Déclaration des variables obligatoire" dans "Outils/Options". De quelle Option s'agit-il ?

Cordialement.
Nonno 94.

[parmi]

Dans l'éditeur VBA, menu Outils et choisis Options
Dans la fenêtre qui s'ouvre, onglet Éditeur, décoche la première case et coche la seconde.
Les prochains classeurs que tu vas créer auront la mention Option Explicit.

Pour ceux qui sont déjà créés, il te faudra ajouter cette mention manuellement...

[Nonno 94]

Parfait. Merci encore et bon après-midi.

Cordialement.
Nonno 94.