Detection de Doublons VBA
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
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
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
Bonjour Tiberias, ThauThème (
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,
Parfait, merci à vous deux !
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
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
Cordialement,
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....
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
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?
Si J3 de feuille1 est vide et J3 de feuille 2 est vide, je n'ai aucun message....
Cordialement,
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
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
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
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
Cordialement,
Re,
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
Bonjour ThauThème,
@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....
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,
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