Discussion :

[Gregk84]

Bonjour,

Je cherche à identifier les doublons dans un listing client. J'ai trouvé le code ci-dessous qui répond presque à mon besoin.

• Je souhaiterais qu'il compare sur 2 colonnes : Col B et Col C
  
• Je souhaiterais que le résultat soit mis en évidence par le surlignement de la la ligne.

Ou (encore mieux)

• Dans une autre feuille.

Merci pour votre aide

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
Option Explicit
Option Base 1
 
Sub listeDoublons()
    Dim Plage As Range
    Dim Tableau(), Resultat() As String
    Dim i As Integer, j As Integer, m As Integer
    Dim Un As Collection
    Dim Doublons As String
 
    Set Un = New Collection
    'La plage de cellules à tester
    Set Plage = Range("A1:A" & Range("A65536").End(xlUp).Row)
 
    Tableau = Plage.Value
    ReDim Preserve Resultat(2, 1)
 
    On Error Resume Next
    'boucle sur la plage à tester
    For i = 1 To Plage.Count
        'Utilise une collection pour rechercher les doublons
        '(les collections n'acceptent que des données uniques)
        Un.Add Tableau(i, 1), Tableau(i, 1)
 
        'S'il y a une erreur (donc presence d'un doublon)
        If Err <> 0 Then
 
            'boucle sur le tableau des doublons pour verifier s'il a deja
            'été identifié
            For j = 1 To m + 1
                'Si oui , on  incrément le compteur
                If Resultat(1, j) = Tableau(i, 1) Then
                    Resultat(2, j) = Resultat(2, j) + 1
                    Err.Clear
                    Exit For
                End If
            Next j
 
                'Si non, on ajoute le doublon dans le tableau
                If Err <> 0 Then
                    Resultat(1, m + 1) = Tableau(i, 1)
                    Resultat(2, m + 1) = 1
 
                    m = m + 1
                    Err.Clear
                    ReDim Preserve Resultat(2, m + 1)
                End If
        End If
    Next i
 
    '----- Affiche la liste er le nombre de doublons --------
    For j = 1 To m
        Doublons = Doublons & Resultat(1, j) & "-->" & _
                    Resultat(2, j) & vbCrLf
    Next j
 
    MsgBox Doublons
End Sub

[Theze]

Bonjour,

Et avec ceci (c'est pas mis dans un tableau mais c'est tout à fait possible, il faut juste savoir comment tu vas les traiter) :

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
 
Sub listeDoublons()
 
    Dim PlageSource As Range
    Dim PlageCible As Range
    Dim Cel As Range
    Dim I As Integer
    Dim Doublons As String
    Dim Adr As String
 
    'défini les plages source et cible
    Set PlageSource = Range([B1], Range("B" & Rows.Count).End(xlUp))
    Set PlageCible = Range([C1], Range("C" & Rows.Count).End(xlUp))
 
    'parcour la plage source afin de rechercher la
    'valeur de la cellule en cour dans la plage cible
    For I = 1 To PlageSource.Count
 
        Set Cel = PlageCible.Find(PlageSource(I), , xlValues, xlWhole)
 
        If Not Cel Is Nothing Then
 
            Adr = Cel.Address
 
            Do
 
                Doublons = Doublons & "Nom : " & Cel.Value & _
                " | Adresse cellule : " & Cel.Address(0, 0) & vbCrLf
 
                Set Cel = PlageCible.FindNext(Cel)
 
            Loop While Cel.Address <> Adr
 
        End If
 
   Next I
 
    MsgBox Doublons
 
End Sub

Hervé.

[Gregk84]

Merci pour ton code, je viens de le tester. Mais j'ai l'impression qu'il cherche les doublons séparément dans chaque colonne.

Si j'ai :

Col B : Nom, Col C : Prénom

Durant Pierre
Durant Charles
Peters Tom

Il me dit que durant est un doublon...

[Theze]

Re,

Je n'avais pas compris que tu voulais faire une recherche en concaténant les deux colonnes. Donc, avec deux dictionnaires (plus rapide qu'une collection) :

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
 
Sub listeDoublons()
 
    Dim Dico1 As Object
    Dim Dico2 As Object
    Dim Valeur As Variant
    Dim Cle As Variant
    Dim Plage As Range
    Dim I As Integer
    Dim Nom As String
    Dim Doublons As String
 
    Set Dico1 = CreateObject("Scripting.Dictionary")
    Set Dico2 = CreateObject("Scripting.Dictionary")
 
    Set Plage = Range([B1], Range("B" & Rows.Count).End(xlUp))
 
    For I = 1 To Plage.Count
 
        Nom = Plage(I) & " " & Plage(I).Offset(0, 1)
 
        If Dico1.exists(Nom) = False Then
            Dico1.Add Nom, Nom
        Else
            If Dico2.exists(Nom) = False Then
                Dico2.Add Nom, 1
            Else
                Dico2(Nom) = Dico2(Nom) + 1
            End If
        End If
 
    Next I
 
    Valeur = Dico2.Items
    Cle = Dico2.keys
 
    For I = 0 To Dico2.Count - 1
        Doublons = Doublons & Cle(I) _
        & " à été trouvé " _
        & Valeur(I) & " fois en doublon" & vbCrLf
    Next I
 
    MsgBox Doublons
 
End Sub

Hervé.

[Gregk84]

Super

Comment faire pour avoir le numéro de la cellule dans le résultat ?

[Theze]

Re,

Ceci convient :

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
 
Sub listeDoublons()
 
    Dim Dico1 As Object
    Dim Dico2 As Object
    Dim Valeur As Variant
    Dim Cle As Variant
    Dim Plage As Range
    Dim I As Integer
    Dim Nom As String
    Dim Doublons As String
 
    Set Dico1 = CreateObject("Scripting.Dictionary")
    Set Dico2 = CreateObject("Scripting.Dictionary")
 
    Set Plage = Range([B1], Range("B" & Rows.Count).End(xlUp))
 
    For I = 1 To Plage.Count
 
        Nom = Plage(I) & " " & Plage(I).Offset(0, 1)
 
        If Dico1.exists(Nom) = False Then
            Dico1.Add Nom, Nom
        Else
            If Dico2.exists(Nom) = False Then
                Dico2.Add Nom, Plage(I).Address(0, 0)
            Else
                Dico2(Nom) = Dico2(Nom) & "; " & Plage(I).Address(0, 0)
            End If
        End If
 
    Next I
 
    Valeur = Dico2.Items
    Cle = Dico2.keys
 
    For I = 0 To Dico2.Count - 1
        Doublons = Doublons & Cle(I) & " se trouve en doublon dans les cellules " & Valeur(I) & vbCrLf
    Next I
 
    MsgBox Doublons
 
End Sub

Hervé.

[Podoeuf]

Bonjour,

Et avec ceci (c'est pas mis dans un tableau mais c'est tout à fait possible, il faut juste savoir comment tu vas les traiter) :

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
 
Sub listeDoublons()
 
    Dim PlageSource As Range
    Dim PlageCible As Range
    Dim Cel As Range
    Dim I As Integer
    Dim Doublons As String
    Dim Adr As String
 
    'défini les plages source et cible
    Set PlageSource = Range([B1], Range("B" & Rows.Count).End(xlUp))
    Set PlageCible = Range([C1], Range("C" & Rows.Count).End(xlUp))
 
    'parcour la plage source afin de rechercher la
    'valeur de la cellule en cour dans la plage cible
    For I = 1 To PlageSource.Count
 
        Set Cel = PlageCible.Find(PlageSource(I), , xlValues, xlWhole)
 
        If Not Cel Is Nothing Then
 
            Adr = Cel.Address
 
            Do
 
                Doublons = Doublons & "Nom : " & Cel.Value & _
                " | Adresse cellule : " & Cel.Address(0, 0) & vbCrLf
 
                Set Cel = PlageCible.FindNext(Cel)
 
            Loop While Cel.Address <> Adr
 
        End If
 
   Next I
 
    MsgBox Doublons
 
End Sub

Hervé.

Bonjour,
Au gré de mes recherches, je suis "tombé" sur cet échange (qui date un peu...). Voila mon problème...
Dans le fichier joint, la Feuil1 contient une macro (bouton jaune) qui active une "Mise en forme conditionnelle" sur la table "t_Essai".
Mon projet final concerne en fait une très grosse table (A1:FV108) contenant près de 500 références.
L'activation de la macro fonctionne bien mais sur ma grosse table elle ralentit considérablement les saisies qu'il s'agisse d'ajouts de références ou de modifications.
Dans la Feuil2, j'ai utilisé une macro trouvée sur le net. Elle fonctionne bien mais que sur les colonnes B et C et je ne sais comment exécuter cette macro sur la table entière (t_Essai2)
J'aime bien l'idée de présentation, même si j'y apporterai quelques modifications que @mapomme m'a suggérées lors de ma dernière discussion.
Autre avantage de cette macro, elle ne reste pas en mémoire comme la "mise en forme conditionnelle" de la Feuil1 et ne ralentit pas mes saisies.

Si vous pouvez m'aider à résoudre cette question (passage de 2 colonnes à l'ensemble d'une table...

Bien cordialement,

Pierre