Macro élimination doublon

[Monturier]

bonjours.

Je cherche qqun qui pourrais me réaliser une macro qui fait ce ci.

Dans un nouveau classeur, feuille1 j'encode une liste noms et dans le même classeur mais dans une feuille différente que je renomme liste
j'ai aussi une liste de noms, la macro dois après un clique sur un bouton que j'ai crée, éliminer donc supprimer les noms de feuille1 si et seulement si ces noms son dans la feuille liste. Attention est'il possible de ne pas prendre en compte l'emplacement des cellules.

merci d'avance

PS : c'est très urgent

monturier.a@wanadoo.be

 

[SVri]

Voila la macro (ta feuille à dédoublonner doit s'appeler "feuil1"):

Ca fera 30 euro ;-)


Dim Li, Li2 As Integer
Dim MaValeur, AutVal As String

Sub SupDoublon()
Li = 1 'début de la recherche dans "feuil1" (mettre 2 si entête de colonne)
Li2 = 1 'idem dans la feuille "liste"
Do
MaValeur = Sheets("feuil1").Cells(Li, 1).Value
If MaValeur = "" Then Exit Do
Li2 = 1
Do
AutVal = Sheets("liste").Cells(Li2, 1).Value
If AutVal = "" Then Exit Do
If AutVal = MaValeur Then Sheets("feuil1").Cells(Li, 1).EntireRow.ClearContents: Exit Do
Li2 = Li2 + 1
Loop While Not AutVal = ""
Li = Li + 1
Loop While Not MaValeur = ""
End Sub

 

[Ti]

Tu n'as pas reçu la macro que je t'ai envoyée par mail ?

 

[SVri]

Bonjour,

Pour supprimer la ligne au lieu d'effacer son contenu (demandé par Marie-T), il faut remplacer, dans le code:
"Cells(Li, 1).EntireRow.ClearContents"
par "Rows(Li).Delete Shift:=xlUp"
Ensuite, comme on a supprimé une ligne, il faut faire "li=li-1" pour ne pas sauter une ligne dans le test !

Cf le code ci-dessous

SVri.



Dim Li, Li2 As Integer
Dim MaValeur, AutVal As String

Sub SupDoublon()
Li = 1 'début de la recherche dans "feuil1" (mettre 2 si entête de colonne)
Li2 = 1 'idem dans la feuille "liste"
Do
MaValeur = Sheets("feuil1").Cells(Li, 1).Value
If MaValeur = "" Then Exit Do
Li2 = 1
Do
AutVal = Sheets("liste").Cells(Li2, 1).Value
If AutVal = "" Then Exit Do
If AutVal = MaValeur Then Sheets("feuil1").Rows(Li).Delete Shift:=xlUp: Li = Li - 1: Exit Do
Li2 = Li2 + 1
Loop While Not AutVal = ""
Li = Li + 1
Loop While Not MaValeur = ""
End Sub