Chercher doublons dans une colonne (dynamique du genre "cells(i,j)") à l'aide de Combobox

**DAO2021** · 16/04/2024, 18h19

Bonjour Forum,

ça fait plusieurs jours que je suis à la recherche d'une macro me permettant de trouver des doublons sur une colonne avec Combobox(Userform).

En fait, je suis entrain de créer un outil qui me permettra de chercher les valeurs en double d'une colonne en sélectionnant un item du Combobox (qui est l'entête d'une colonne) et ensuite, la macro va aller chercher uniquement dans cette même colonne les valeurs en double. sachant que la colonne n'est pas fixe...

Le Combobox marche très bien, il arrive à lire les entêtes d'une colonne et à trouver la colonne recherchée sur la feuille Excel.

Mais Le problème se situe au niveau de la syntaxe (du ComanButton)qui consiste à trouver les doublons, une fois que le Combobox a trouvé la colonne.
Je ne sais pas si ma demande est claire

Mais si non, voici mon code concernant la partie combobox qui marche parfaitement:

Code VBA :

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
Private Sub Userform_initialize ()
 
Dim der_colonne: der_colonn = Cells(1, Columns.Count).End(xlToLeft).Column
 
Me.ComboBox111.Clear
Me.ComboBox111.AddItem ""
For Each cel In Range(("A1:AA1") & der_colonne)
    Me.ComboBox111 = cel
    If Me.ComboBox111.ListIndex = -1 Then
       Me.ComboBox111.AddItem cel
    End If
     Me.ComboBox111.Text = Me.ComboBox111.List(0)
 
      Me.Width = 900
      Me.Height = 500
 
Next cel
 
End Sub

Et le code qui consiste à trouver le doublons mais qui ne marche pas:

Code VBA :

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
Private Sub CommandButton1_Click()
ThisWorkbook.Sheets("Data").Select
 
If Me.ComboBox111.Value = "" Then
MsgBox ("Vous n'aviez rien séléctionné."), vbRetryCancel
Exit Sub
 
 
Else:
 
Dim der_colonne: der_colonn = Cells(1, Columns.Count).End(xlToLeft).Column
Dim der_ligne, choix2
Dim Ligne, colonne
Dim plage As Variant, cell As Variant
Dim test, nb, compteur, contenu, i, j, lig, res_tes, res_test, messageFin As Byte
Application.ScreenUpdating = False
 test = Timer
   nb = 0
   i = 1
 
        For colonne = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
        For Ligne = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
        If ComboBox111.Value = Cells(1, colonne).Value Then
        If Cells(1 + Ligne, colonne) <> "" Then
 
 
         'plage = Cells(1 + Ligne & Rows.Count, 1).End(xlUp).Row
 
         plage = Cells(1 + Ligne).Rows
 
         For Each cel In plage
        ' Vérifier si la valeur sélectionnée se trouve déjà dans la ligne
        If Application.CountIf(cell, plage.Value) > 1 Then
            MsgBox "Doublon trouvé dans la ligne !"
            Exit Sub
           End If
        Next cel
 
ActiveWindow.ScrollRow = 10
 
       End If
     End If
   Next Ligne
   Next colonne
ActiveWindow.ScrollRow = 1
 
 
Application.ScreenUpdating = True
End If
 
End Sub

**Franc** · 16/04/2024, 20h57

Salut, teste ceci, j'utilise un dictionnaire pour vérifier l'existence de doublons. S'il y en a, la macro affiche un msgbox avec les doublons trouvés et le n° de ligne.

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
Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Data")
 
        If Me.ComboBox111.Value = "" Then
            MsgBox ("Vous n'aviez rien séléctionné."), vbRetryCancel
            Exit Sub
        Else
            Dim col As Range
            Set col = ws.Rows(1).Find(What:=Me.ComboBox111.Value, LookIn:=xlValues, LookAt:=xlWhole)
 
            If Not col Is Nothing Then
                Dim dict As Object
                Set dict = CreateObject("Scripting.Dictionary")
 
                Dim cell As Range
                Dim doublons As String
                For Each cell In ws.Columns(col.Column).Cells
                    If cell.Row > 1 And cell.Value <> "" Then
                        If dict.Exists(cell.Value) Then
                            doublons = doublons & "Doublon trouvé dans la ligne " & cell.Row & vbCrLf
                        Else
                            dict.Add cell.Value, Nothing
                        End If
                    End If
                Next cell
 
                If doublons <> "" Then
                    MsgBox doublons
                Else
                    MsgBox "Aucun doublon trouvé."
                End If
            End If
        End If
End Sub

**DAO2021** · 16/04/2024, 23h31

Envoyé par Franc

Salut, teste ceci, j'utilise un dictionnaire pour vérifier l'existence de doublons. S'il y en a, la macro affiche un msgbox avec les doublons trouvés et le n° de ligne.

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
Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Data")
 
        If Me.ComboBox111.Value = "" Then
            MsgBox ("Vous n'aviez rien séléctionné."), vbRetryCancel
            Exit Sub
        Else
            Dim col As Range
            Set col = ws.Rows(1).Find(What:=Me.ComboBox111.Value, LookIn:=xlValues, LookAt:=xlWhole)
 
            If Not col Is Nothing Then
                Dim dict As Object
                Set dict = CreateObject("Scripting.Dictionary")
 
                Dim cell As Range
                Dim doublons As String
                For Each cell In ws.Columns(col.Column).Cells
                    If cell.Row > 1 And cell.Value <> "" Then
                        If dict.Exists(cell.Value) Then
                            doublons = doublons & "Doublon trouvé dans la ligne " & cell.Row & vbCrLf
                        Else
                            dict.Add cell.Value, Nothing
                        End If
                    End If
                Next cell
 
                If doublons <> "" Then
                    MsgBox doublons
                Else
                    MsgBox "Aucun doublon trouvé."
                End If
            End If
        End If
End Sub

Merci beaucoup FRANC ça a l'air de très bien marcher, c'est à peu près ce que je voulais.
En revanche, j'ai juste 2 petites préoccupations: Est-ce possible de surligner en jaune ces doublons trouvés à la place du msgbox ?
J'ai essayé de rajouter apres

Code :

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

1
2
3
4
If dict.Exists(cell.Value) Then
                            doublons = doublons & "Doublon trouvé dans la ligne " & cell.Row & vbCrLf
                           Cells(cell.Row).Interior.ColorIndex = 3 'pour colorer la cellule
                           Cells(cell.Row).Font.ColorIndex = 2 'pour colorer la cellule

Mais ça n'a pas fonctionné et en plus quand je lance la macro, il y a un message qui s'affiche "Exécution interrompue". Et si je ne clique pas sur continuer, la macro ne s'exécute pas.

Merci encore

**Franc** · 17/04/2024, 00h04

Essaie comme ceci:

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
Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Data")
 
    If Me.ComboBox111.Value = "" Then
        MsgBox ("Vous n'aviez rien séléctionné."), vbRetryCancel
        Exit Sub
    Else
        Dim col As Range
        Set col = ws.Rows(1).Find(What:=Me.ComboBox111.Value, LookIn:=xlValues, LookAt:=xlWhole)
 
        If Not col Is Nothing Then
            Dim dict As Object
            Set dict = CreateObject("Scripting.Dictionary")
 
            Dim cell As Range
            Dim Doublons As Boolean
            Doublons = False
            For Each cell In ws.Columns(col.Column).Cells
                If cell.Row > 1 And cell.Value <> "" Then
                    If dict.Exists(cell.Value) Then
                        cell.Interior.Color = RGB(255, 255, 0) ' Surligner en jaune
                        Doublons = True
                    Else
                        dict.Add cell.Value, Empty
                    End If
                End If
            Next cell
 
            If Not Doublons Then
                MsgBox "Aucun doublon trouvé."
            End If
        End If
    End If
End Sub

**DAO2021** · 17/04/2024, 02h18

Envoyé par DAO2021

Bonjour Forum,

ça fait plusieurs jours que je suis à la recherche d'une macro me permettant de trouver des doublons sur une colonne avec Combobox(Userform).

En fait, je suis entrain de créer un outil qui me permettra de chercher les valeurs en double d'une colonne en sélectionnant un item du Combobox (qui est l'entête d'une colonne) et ensuite, la macro va aller chercher uniquement dans cette même colonne les valeurs en double. sachant que la colonne n'est pas fixe...

Le Combobox marche très bien, il arrive à lire les entêtes d'une colonne et à trouver la colonne recherchée sur la feuille Excel.

Mais Le problème se situe au niveau de la syntaxe (du ComanButton)qui consiste à trouver les doublons, une fois que le Combobox a trouvé la colonne.
Je ne sais pas si ma demande est claire

Mais si non, voici mon code concernant la partie combobox qui marche parfaitement:

Code VBA :

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
Private Sub Userform_initialize ()
 
Dim der_colonne: der_colonn = Cells(1, Columns.Count).End(xlToLeft).Column
 
Me.ComboBox111.Clear
Me.ComboBox111.AddItem ""
For Each cel In Range(("A1:AA1") & der_colonne)
    Me.ComboBox111 = cel
    If Me.ComboBox111.ListIndex = -1 Then
       Me.ComboBox111.AddItem cel
    End If
     Me.ComboBox111.Text = Me.ComboBox111.List(0)
 
      Me.Width = 900
      Me.Height = 500
 
Next cel
 
End Sub

Et le code qui consiste à trouver le doublons mais qui ne marche pas:

Code VBA :

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
Private Sub CommandButton1_Click()
ThisWorkbook.Sheets("Data").Select
 
If Me.ComboBox111.Value = "" Then
MsgBox ("Vous n'aviez rien séléctionné."), vbRetryCancel
Exit Sub
 
 
Else:
 
Dim der_colonne: der_colonn = Cells(1, Columns.Count).End(xlToLeft).Column
Dim der_ligne, choix2
Dim Ligne, colonne
Dim plage As Variant, cell As Variant
Dim test, nb, compteur, contenu, i, j, lig, res_tes, res_test, messageFin As Byte
Application.ScreenUpdating = False
 test = Timer
   nb = 0
   i = 1
 
        For colonne = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
        For Ligne = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
        If ComboBox111.Value = Cells(1, colonne).Value Then
        If Cells(1 + Ligne, colonne) <> "" Then
 
 
         'plage = Cells(1 + Ligne & Rows.Count, 1).End(xlUp).Row
 
         plage = Cells(1 + Ligne).Rows
 
         For Each cel In plage
        ' Vérifier si la valeur sélectionnée se trouve déjà dans la ligne
        If Application.CountIf(cell, plage.Value) > 1 Then
            MsgBox "Doublon trouvé dans la ligne !"
            Exit Sub
           End If
        Next cel
 
ActiveWindow.ScrollRow = 10
 
       End If
     End If
   Next Ligne
   Next colonne
ActiveWindow.ScrollRow = 1
 
 
Application.ScreenUpdating = True
End If
 
End Sub

Franchement, merci beaucoup Franc pour ta réactivité. ça fonctionne parfaitement.
C'est exactement, ce que je voulais.
À l'occasion, j'utiliserai tes fonctions pour d'autres projets

Chercher doublons dans une colonne (dynamique du genre "cells(i,j)") à l'aide de Combobox [XL-365]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager