Detection de Doublons VBA

Le 13/09/2019 à 10:05

Bonjour Forum,

Je viens à nouveau vous solliciter sur un problème que je rencontre,

J'ai plusieurs feuilles, dans la colonne J de chaque feuille, j'ai des noms de personne et j'aimerai qu'en VBA dans le code de chaque feuille, on detecte si le nom d'une personne est à la meme case mais dans l'autre feuille.

Exemple:

Si Marie en J2 de la Feuille 1 se retrouve sur la cellule J2 de la Feuille 2, alors MessageBox(" attention doublon ")

Si Jerome en J2 de la Feuille 1 se retrouve sur la cellule J2 de la Feuille 2, alors MessageBox(" attention doublon ")

Je pourrai le faire en Mise en forme conditionnelle, mais je veux vraiment qu'une MsgBox apparaisse.

Bien cordialement

18nouveau-feuille-de-calcul-microsoft-excel.xlsx (8.94 Ko)
Le 13/09/2019 à 10:40

Bonjour Tibérias, bonjour le forum,

Essaie comme ça :

Sub Macro1()
Dim S1 As Worksheet 'déclare la variable S1 (onglet Salle1)
Dim S2 As Worksheet 'déclare la variable S2 (onglet Salle2)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim R As Range 'déclare la variable R (Recherche)
Dim AD As String 'déclare la variable AD (ADresse)

Set S1 = Worksheets("Salle1") 'définit l'onglet S1
Set S2 = Worksheets("Salle2") 'définit l'onglet S2
For Each CEL In S1.Columns(10).SpecialCells(xlCellTypeConstants) 'boucle surt toutes les cellules éditées de la colonne 10 (=> J)
    AD = CEL.Address(0, 0) 'définit l'adresse AD de la cellule CEL
    'définit la recherche R (Recherche la valeur entière de la cellule CEL dans la colonne J de l'onglet S2)
    Set R = S2.Columns(10).Find(CEL.Value, , xlValues, xlWhole)
    If Not R Is Nothing Then 'condition : si au moins une occurrence est trouvée
        'si l'adresse de l'occurrence trouvée est la même que AD message
        If R.Address(0, 0) = AD Then MsgBox "Doublon de " & CEL.Value & " !"
    End If 'fin de la condition
Next CEL 'prochane cellule de la boucle
End Sub
Le 13/09/2019 à 11:15

C'est super ! Un grand merci, cependant quand je fais le test, dès lors qu'il detecte un doublon la message box s'affiche 3 fois d'affilée

Bien cordialement

Le 13/09/2019 à 12:15

Bonjour Tiberias, ThauThème ( ), le forum,

Peut-être ainsi:

Sub Macro1()

Dim S1 As Worksheet 'déclare la variable S1 (onglet Salle1)
Dim S2 As Worksheet 'déclare la variable S2 (onglet Salle2)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim R As Range 'déclare la variable R (Recherche)
Dim AD As String 'déclare la variable AD (ADresse)
Dim msg As String

Set S1 = Worksheets("Salle1") 'définit l'onglet S1
Set S2 = Worksheets("Salle2") 'définit l'onglet S2
For Each CEL In S1.Columns(10).SpecialCells(xlCellTypeConstants) 'boucle surt toutes les cellules éditées de la colonne 10 (=> J)
    AD = CEL.Address(0, 0) 'définit l'adresse AD de la cellule CEL
    'définit la recherche R (Recherche la valeur entière de la cellule CEL dans la colonne J de l'onglet S2)
    Set R = S2.Columns(10).Find(CEL.Value, , xlValues, xlWhole)
    If Not R Is Nothing Then 'condition : si au moins une occurrence est trouvée
        'si l'adresse de l'occurrence trouvée est la même que AD message
        If R.Address(0, 0) = AD Then msg = msg & "Doublon de " & CEL.Value & " !" & Chr(10)
    End If 'fin de la condition
Next CEL 'prochane cellule de la boucle
     MsgBox msg
End Sub

Cordialement,

Le 13/09/2019 à 13:45

Parfait, merci à vous deux !

Le 16/09/2019 à 11:28

Re,

Finalement, je me suis trompé il y a toujours ce probleme, avec les 3 MsgBox qui s'enchaine, et même lorsque je supprime une cellule, une MsgBox apparait car j'ai intégré le code dans l'evenement " Private Sub Worksheet_Change(ByVal Target As Range) "

Mais ça devrait pas afficher de msgbox lorsque je supprime une cellule

Bien cordialement

Le 16/09/2019 à 17:42

Bonjour Tiberias, le fil,

il y a toujours ce problème, avec les 3 MsgBox qui s'enchaine

Je ne rencontre pas ce problème sur mon excel....

Si plusieurs doublons, une seule msgbox avec tous les doublons...

En revanche , si aucun doublon, message vide.

Attention toutefois, tu utilises l'évènement change, donc tant qu'il subsistera des doublons, un message te l'indiquera...

A tester...(dans le module de la feuille 1)

Private Sub Worksheet_Change(ByVal Target As Range)

Dim S1 As Worksheet 'déclare la variable S1 (onglet Salle1)
Dim S2 As Worksheet 'déclare la variable S2 (onglet Salle2)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim R As Range 'déclare la variable R (Recherche)
Dim AD As String 'déclare la variable AD (ADresse)
Dim msg As String

Set S1 = Worksheets("Salle1") 'définit l'onglet S1
Set S2 = Worksheets("Salle2") 'définit l'onglet S2

For Each CEL In S1.Columns(10).SpecialCells(xlCellTypeConstants) 'boucle surt toutes les cellules éditées de la colonne 10 (=> J)
    AD = CEL.Address(0, 0) 'définit l'adresse AD de la cellule CEL

    'définit la recherche R (Recherche la valeur entière de la cellule CEL dans la colonne J de l'onglet S2)
    Set R = S2.Columns(10).Find(CEL.Value, , xlValues, xlWhole)

    If Not R Is Nothing Then 'condition : si au moins une occurrence est trouvée
        'si l'adresse de l'occurrence trouvée est la même que AD message
        If R.Address(0, 0) = AD Then
             msg = msg & "Doublon de " & CEL.Value & " !" & Chr(10)
        Else
             msg = ""
        End If
    End If 'fin de la condition

Next CEL 'prochane cellule de la boucle

     If msg <> "" Then MsgBox msg

End Sub
12nouveau-feuille-de-calcul-microsoft-excel.xlsm (15.98 Ko)

Cordialement,

Le 18/09/2019 à 11:44

Bonjour le fil, bonjour le forum,

Peu disponible en ce moment je suis désolé pour le retard. idem XorSankukai, pas de problème chez moi. Envoie un fichier et explique nous de manière détaillée les procédures qui provoque les erreurs....

Le 18/09/2019 à 12:34

En fait il faudrait detecter quand CEL.VALUE est vide car sinon la msg box affiche " Doublons de ! " alors que si CEL.VALUE est vide il devrait rien afficher du tout.

Cdt

Le 18/09/2019 à 12:43

Bonjour Tiberias, ThauThème,

En fait il faudrait detecter quand CEL.VALUE est vide car sinon la msg box affiche " Doublons de ! " alors que si CEL.VALUE est vide il devrait rien afficher du tout.

Je ne parviens pas à reproduire ce problème avec mon fichier?

https://forum.excel-pratique.com/posting.php?f=2&mode=reply&t=129641&sid=3e72b0cd405e566c220de0d7f2d5be9b#pr796655

Si J3 de feuille1 est vide et J3 de feuille 2 est vide, je n'ai aucun message....

Cordialement,

Le 18/09/2019 à 12:56

Voici le fichier où le code sera implanté à la fin, j'ai bien mis votre code dans l'onglet où je souhaite qu'il y est la detection, et là ça ne semble pas fonctionner.

Cdt

11nouveau-feuille-de-calcul-microsoft-excel-3.xlsm (236.25 Ko)
Le 18/09/2019 à 18:27

Re,

Essaie comme ça :

Sub Macro1()
Dim S1 As Worksheet 'déclare la variable S1 (onglet Salle1)
Dim S2 As Worksheet 'déclare la variable S2 (onglet Salle2)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim R As Range 'déclare la variable R (Recherche)
Dim AD As String 'déclare la variable AD (ADresse)

Set S1 = Worksheets("CAGE-C01") 'définit l'onglet S1
Set S2 = Worksheets("PM-C03") 'définit l'onglet S2
For Each CEL In S1.Columns(10).SpecialCells(xlCellTypeConstants) 'boucle surt toutes les cellules éditées de la colonne 10 (=> J)
    AD = CEL.Address(0, 0) 'définit l'adresse AD de la cellule CEL
    'définit la recherche R (Recherche la valeur entière de la cellule CEL dans la colonne J de l'onglet S2)
    Set R = S2.Columns(10).Find(CEL.Value, , xlValues, xlWhole)
    If Not R Is Nothing Then 'condition : si au moins une occurrence est trouvée
        'si l'adresse de l'occurrence trouvée est la même que AD message
        If R.Address(0, 0) = AD Then MsgBox "Doublon de " & CEL.Value & " !"
    End If 'fin de la condition
Next CEL 'prochane cellule de la boucle
End Sub
Le 18/09/2019 à 18:59
ThauThème a écrit :

Re,

Essaie comme ça :

Sub Macro1()
Dim S1 As Worksheet 'déclare la variable S1 (onglet Salle1)
Dim S2 As Worksheet 'déclare la variable S2 (onglet Salle2)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim R As Range 'déclare la variable R (Recherche)
Dim AD As String 'déclare la variable AD (ADresse)

Set S1 = Worksheets("CAGE-C01") 'définit l'onglet S1
Set S2 = Worksheets("PM-C03") 'définit l'onglet S2
For Each CEL In S1.Columns(10).SpecialCells(xlCellTypeConstants) 'boucle surt toutes les cellules éditées de la colonne 10 (=> J)
    AD = CEL.Address(0, 0) 'définit l'adresse AD de la cellule CEL
    'définit la recherche R (Recherche la valeur entière de la cellule CEL dans la colonne J de l'onglet S2)
    Set R = S2.Columns(10).Find(CEL.Value, , xlValues, xlWhole)
    If Not R Is Nothing Then 'condition : si au moins une occurrence est trouvée
        'si l'adresse de l'occurrence trouvée est la même que AD message
        If R.Address(0, 0) = AD Then MsgBox "Doublon de " & CEL.Value & " !"
    End If 'fin de la condition
Next CEL 'prochane cellule de la boucle
End Sub

Il y'a une différence entre ce code là et celui de ta premiere réponse ?

Cdt

Le 18/09/2019 à 20:31

Bonsoir le fil,

Un essai....

Private Sub Worksheet_Change(ByVal Target As Range)

Dim S1 As Worksheet 'déclare la variable S1 (onglet Salle1)
Dim S2 As Worksheet 'déclare la variable S2 (onglet Salle2)
Dim msg As String
Dim i As Long, dl1 As Long

 Application.ScreenUpdating = False

Set S1 = Worksheets("CAGE-C01")                            'définit l'onglet S1
   dl1 = S1.Range("C" & Rows.Count).End(xlUp).Row          'définit dernière ligne de S1 en fonction de la colonne C
Set S2 = Worksheets("PM-C03")                              'définit l'onglet S2

   With S1                                                 'on agit sur S1
    For i = 3 To dl1                                       'boucle de la ligne 3 à la dernière ligne
     If .Range("J" & i) <> "" Then                         'si cellule remplie
      If .Range("J" & i) = S2.Range("J" & i) Then msg = msg & "Doublon de   " & S1.Range("J" & i).Value & "  en  " & S1.Range("J" & i).Address & Chr(10)
     End If
    Next i
   End With

   If msg <> "" Then MsgBox msg

 Application.ScreenUpdating = True

End Sub
5test-tiberias.xlsm (244.58 Ko)

Cordialement,

Le 19/09/2019 à 08:42

Re,

Tiberias a écrit :

Il y'a une différence entre ce code là et celui de ta premiere réponse ?

Oops, pardon, tu as raison ! Je t'ai envoyé le mauvais code. Je refais et je t'envoie.

[Édition]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim S2 As Worksheet 'déclare la variable S2 (onglet Salle2)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim R As Range 'déclare la variable R (Recherche)
Dim AD As String 'déclare la variable AD (ADresse)
Dim DL As Integer 'déclare la varaible DL (Dernière Ligne)

Set S2 = Worksheets("PM-C03") 'définit l'onglet S2
DL = Cells(Application.Rows.Count, "J").End(xlUp).Row
For Each CEL In Range("J3:J" & DL) 'boucle surt toutes les cellules éditées de la colonne J
    If CEL.Value <> "" Then
        AD = CEL.Address(0, 0) 'définit l'adresse AD de la cellule CEL
        'définit la recherche R (Recherche la valeur entière de la cellule CEL dans la colonne J de l'onglet S2)
        Set R = S2.Columns(10).Find(CEL.Value, , xlValues, xlWhole)
        If Not R Is Nothing Then 'condition : si au moins une occurrence est trouvée
            'si l'adresse de l'occurrence trouvée est la même que AD message
            If R.Address(0, 0) = AD Then MsgBox "Doublon de " & CEL.Value & " !"
        End If 'fin de la condition
    End If
Next CEL 'prochane cellule de la boucle
End Sub
Le 19/09/2019 à 10:10

Bonjour ThauThème, , Tibérias,

@ThauThème:

J'avais tenté d'adapter ton code mais hélas, sans arriver au résultat escompté.

Sur mon excel, il subsiste un souci.

Si tu as Steve en J5 et J6 sur les 2 feuilles, seul la msgbox avec J5 apparait.

Si tu supprimes Steve en J5, aucun message me stipule le doublon en J6...

En revanche, si tu supprimes Steve en J6, le message doublon en J5 apparait bien....

10test.xlsm (245.69 Ko)

Rencontres-tu ce souci également ?

J'ai donc opté pour une simple boucle afin de lister toutes les valeurs en associant leurs emplacements respectifs.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim S1 As Worksheet 'déclare la variable S1 (onglet Salle1)
Dim S2 As Worksheet 'déclare la variable S2 (onglet Salle2)
Dim msg As String
Dim i As Long, dl1 As Long

 Application.ScreenUpdating = False

Set S1 = Worksheets("CAGE-C01")                            'définit l'onglet S1
   dl1 = S1.Range("C" & Rows.Count).End(xlUp).Row          'définit dernière ligne de S1 en fonction de la colonne C
Set S2 = Worksheets("PM-C03")                              'définit l'onglet S2

   With S1                                                 'on agit sur S1
    For i = 3 To dl1                                       'boucle de la ligne 3 à la dernière ligne
     If .Range("J" & i) <> "" Then                         'si cellule remplie
      If .Range("J" & i) = S2.Range("J" & i) Then msg = msg & "Doublon de   " & S1.Range("J" & i).Value & "  en  " & S1.Range("J" & i).Address & Chr(10)
     End If
    Next i
   End With

   If msg <> "" Then MsgBox msg

 Application.ScreenUpdating = True

End Sub

Amitiés,

Le 19/09/2019 à 13:19
xorsankukai a écrit :

Bonjour ThauThème, , Tibérias,

@ThauThème:

J'avais tenté d'adapter ton code mais hélas, sans arriver au résultat escompté.

Sur mon excel, il subsiste un souci.

Si tu as Steve en J5 et J6 sur les 2 feuilles, seul la msgbox avec J5 apparait.

Si tu supprimes Steve en J5, aucun message me stipule le doublon en J6...

En revanche, si tu supprimes Steve en J6, le message doublon en J5 apparait bien....

test .xlsm

Rencontres-tu ce souci également ?

J'ai donc opté pour une simple boucle afin de lister toutes les valeurs en associant leurs emplacements respectifs.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim S1 As Worksheet 'déclare la variable S1 (onglet Salle1)
Dim S2 As Worksheet 'déclare la variable S2 (onglet Salle2)
Dim msg As String
Dim i As Long, dl1 As Long

 Application.ScreenUpdating = False

Set S1 = Worksheets("CAGE-C01")                            'définit l'onglet S1
   dl1 = S1.Range("C" & Rows.Count).End(xlUp).Row          'définit dernière ligne de S1 en fonction de la colonne C
Set S2 = Worksheets("PM-C03")                              'définit l'onglet S2

   With S1                                                 'on agit sur S1
    For i = 3 To dl1                                       'boucle de la ligne 3 à la dernière ligne
     If .Range("J" & i) <> "" Then                         'si cellule remplie
      If .Range("J" & i) = S2.Range("J" & i) Then msg = msg & "Doublon de   " & S1.Range("J" & i).Value & "  en  " & S1.Range("J" & i).Address & Chr(10)
     End If
    Next i
   End With

   If msg <> "" Then MsgBox msg

 Application.ScreenUpdating = True

End Sub

Amitiés,

Merci beaucoup xorsankukai, ça a l'air de fonctionner du feu de dieu, je vais essayer de changer un peu ton code pour qu'il y soit inscrit la date à laquelle la personne est assignée avec ainsi le nom de l'onglet pour que ça soit le plus parlant possible.

Encore merci c'est très bien

Rechercher des sujets similaires à "detection doublons vba"