effacer des doublons

[panda02]

Bonjour,

je cherche une méthode pour effacer des doublons, triplons, ... dans une longue liste déjà triée.
Donc les valeurs identiques se retrouvent l'une en dessous de l'autre.
J'ai essayé deux manières d'écrire cette macro mais elle ne marche qu'à moitié et je comprends pas pourquoi.

****** version 1
Do While ActiveCell.Value <> ""
If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
Rows(ActiveCell.Row).Select
Selection.Delete Shift:=xlUp
End If
If ActiveCell.Value = ActiveCell.Offset(-2, 0).Value Then
Rows(ActiveCell.Row).Select
Selection.Delete Shift:=xlUp
End If
If ActiveCell.Value = ActiveCell.Offset(-3, 0).Value Then
Rows(ActiveCell.Row).Select
Selection.Delete Shift:=xlUp
End If
If ActiveCell.Value = ActiveCell.Offset(-4, 0).Value Then
Rows(ActiveCell.Row).Select
Selection.Delete Shift:=xlUp
End If
If ActiveCell.Value = ActiveCell.Offset(-5, 0).Value Then
Rows(ActiveCell.Row).Select
Selection.Delete Shift:=xlUp
End If

ActiveCell.Offset(1, 0).Select
Loop


**** version 2
Do While ActiveCell.Value <> ""
If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Or ActiveCell.Value = ActiveCell.Offset(-2, 0).Value Or ActiveCell.Value = ActiveCell.Offset(-3, 0).Value Or ActiveCell.Value = ActiveCell.Offset(-4, 0).Value Or ActiveCell.Value = ActiveCell.Offset(-5, 0).Value Then
Rows(ActiveCell.Row).Select
Selection.Delete Shift:=xlUp
End If

ActiveCell.Offset(1, 0).Select
Loop

... avec les deux méthode, ça efface bien un enregistrement si j'ai un doublon, maios si j'ai une triplette ça n'efface qu'un seul et je reste avec un doublon, si j'ai 6 fois le même enregistrement à la fin il en efface 3 et m'en laisse 3
.... quelqu'un pourrait-il me dire ce qui cloche dans ma méthode ?

Merci d'avance

 

[Brozad]

Re : effacer des doublons

Il faut que tu compares toujours par rapport à ta ligne précédente

Essaie juste

If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
Rows(ActiveCell.Row).Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(-1, 0).Select
End If

ActiveCell.Offset(-1, 0).Select te permet de compenser la suppression de ligne.

 

[VDAVID]

Re : effacer des doublons

Bonjour Panda02,

Difficile d'y voir clair avec les ActiveCell

Un exemple en P.J, pour effacer les doublons consécutifs.

Pour effacer des doublons en supprimant des lignes, il vaut mieux partir du bas et remonter, cela évite de sauter une ligne à chaque effacement de doublons.

Bonne journée !

EDIT: Bonjour Brozad

 

[panda02]

Re : effacer des doublons - RESOLU

merci à vous deux
j'avais pas du tout pensé au fait qu'une fois la ligne effacée je me retrouvais une ligne plus bas .. donc en effet il n'effacer qu'une ligne sur deux quand j'avais plus de deux lignes bien vu Brozad
Vdavid ta technqieu est en effet plus "propre" mais bon je suis fénéant je garde ma mthode qui est plus lisible pour moi, par contre j'ai profité quand même de ton exemple pour réduire la longueur de la commande pour effacer la ligne

pour info ma commande devient donc
Range("A13").Select
Do While ActiveCell.Value <> ""
If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
Rows(ActiveCell.Row).Delete
ActiveCell.Offset(-1, 0).Select
End If
ActiveCell.Offset(1, 0).Select
Loop

merci à vous deux