Doublons...

[leporc]

Bonjour a tous !

Encore une histoire de doublons !

Mon probleme est le suivant : j'ai un code ecrit par Jean-Mickael qui me permet a partir de 2 listes de noms d'identifier les doublons. Ce code me met ainsi les noms qui diffèrent des 2 colonnes dans une autre feuille.

Sub lancer()

test
test2

End Sub

Sub test()

Application.ScreenUpdating = False

Dim a As Integer
Dim b As Integer
Dim boucle_a As Integer
Dim boucle_b As Integer
Dim val_a As String
Dim val_b As String
Dim cell As Range

Range("A1:B500").Interior.ColorIndex = 2

a = Range("A500").End(xlUp).Row
b = Range("B500").End(xlUp).Row
For boucle_a = 3 To a
val_a = Cells(boucle_a, 1).Value
For boucle_b = 3 To b
val_b = Cells(boucle_b, 2).Value
If val_a = val_b Then Range("B" & boucle_b).Interior.ColorIndex = 4
If val_b = val_a Then Range("A" & boucle_a).Interior.ColorIndex = 4
If val_a = val_b Then Range("B" & boucle_b).Copy Destination:=Sheets("Feuil2").Range("A65536").End(xlUp).Offset(1, 0)
If val_b = val_a Then Range("A" & boucle_a).Copy Destination:=Sheets("Feuil2").Range("B65536").End(xlUp).Offset(1, 0)
Next boucle_b

Sheets(1).Select
For Each cell In Range("A3:A500")
If cell.Interior.ColorIndex = 2 Then Range("A3:A500").Interior.ColorIndex = 3

Next cell

Sheets(1).Select
For Each cell In Range("B3:B500")
If cell.Interior.ColorIndex = 2 Then Range("B3:B500").Interior.ColorIndex = 8

Next cell

Next boucle_a

Application.ScreenUpdating = True

End Sub

Sub test2()

Application.ScreenUpdating = False

For Each cell In Range("A3:A500")
If cell.Interior.ColorIndex = 3 Then cell.Copy Destination:=Sheets("Feuil3").Range("A65536").End(xlUp).Offset(1, 0)

Next cell

For Each cell In Range("B3:B500")
If cell.Interior.ColorIndex = 8 Then cell.Copy Destination:=Sheets("Feuil3").Range("B65536").End(xlUp).Offset(1, 0)

Next cell

Sheets(1).Select

Application.ScreenUpdating = True

End Sub

Ce qui me pose probleme, c'est qu'a present j'ai également les prenoms des personnes, et il me faudrait rajouter au code de jean Mickael quelques lignes afin qu'Excel puisse identifier les doublons qui ont le même nom et même prénom. Je vous transmets le fichier nom_prenoms.
Voila !

Merci d'avance pour votre aide a tous.

Cordialement,
Leporc

 

[Catrice]

Re : Doublons...

Bonjour,

Ci-joint un bout de code

 

[Catrice]

Re : Doublons...

Re,

Une autre version qui met la couleur

 

[Catrice]

Re : Doublons...

Bonsoir,

Ci-joint, une autre version.

 

[Staple1600]

Re : Doublons...

Bonsoir


Une version fait à la mano (avec l'enregistreur de macro)

 

[Catrice]

Re : Doublons...

Bonsoir Stale1600,

Je crois qu'on n'a pas du comprendre la meme chose.
Pour ma part, je crois que "leporc" veut dédoublonner entre 2 listes (2 colonnes) et non pas dans la meme liste (1 colonne).
A suivre ...

 

[leporc]

Re : Doublons...

Bonjour Catrice, Staple600, le forum,

Merci pour vos réponses ! La solution s'approche plus de celle que Catrice m'a donnée.
Mais il y a encore quelques problèmes a priori. Je t'envois la macro que tu m'as créee avec d'autres noms. Tu verras qu'il y a un probleme.

De plus il y a des noms oubliés tels que "MONTOUX" "NONCLE" et "PREATO". Donc je sais pas si ca t'aidera, en tous cas merci beaucoup.

Cordialement,
Leporc

 

[Catrice]

Re : Doublons...

Bonjour,

Je n'avais pas fait attention à ce point, il faut tester les 2 listes.
Il y avait effectivement un petit bug dans ma macro.

Essaye le fichier joint.

 

[leporc]

Re : Doublons...[repondu]

Que dire sinon un grand merci ?

C'est parfait, pas de bug, et rapide.
Encore merci.

A bientot

cordialement,
Leporc