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
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