supression de doublons amélioré

shadoune · 1 Septembre 2009

Bonjour,

je travaille sur un fichier ce ce type:

colonneA colonneB
Nom Fréquence
toto 3
tata 1
titi 4
tutu 2
tete 2
tete 1

Je voudrais supprimer une ligne à chaque fois qu'un nom de la colonne A est en doublon (comme ici tete). Bon ça je sais déjà faire!

Sub sup_doublons()
Range("B2").Select
Do While ActiveCell <> ""
If ActiveCell = ActiveCell.Offset(-1, 0) Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub

Mais la y'a une particularité que je ne sais pas intégrer :

- quand un nom est répété, il faut tenir compte de la colonne B et garder uniquement la ligne ayant la fréquence la plus élevée (il peut y avoir des répétitions de plus de 2)

- il peut arriver que les répétitions aient la même fréquence, dans ce cas conserver la première ligne.

Si quelqu'un pouvait m'aider ce sera super!

Merci

mutzik · 1 Septembre 2009

Re : supression de doublons amélioré

bonjour,

1. si tu trie ta liste par col A puis par col b en ordre descendant,
2. tu commences en bas de la liste
3. si la cellule Ax = Ax-1, tu effaces cette ligne puisque le tri fait qu'elle est forcément inf ou égale à celle du dessus
CQFD

pedrag31 · 1 Septembre 2009

Re : supression de doublons amélioré

Bonjour Shadoune, Bonjour Mutzik, le forum,

Avec le VBA, on pourrait peut etre essayer avec un test et un offset:

Code:

Sub sup_doublons()
Range("B2").Select
Do While ActiveCell <> ""

[COLOR="Green"]'compare la cellule active et la cellule suivante ET les valeurs de la frequence (colonne C) de ces memes cellules, tri croissant comme suggere Mutzik[/COLOR]
If ActiveCell = ActiveCell.Offset(1, 0) _
[COLOR="Red"]And ActiveCell.Offset(, 1).Value < ActiveCell.Offset(1, 1).Value[/COLOR] Then

[COLOR="Green"]'supprime la ligne de la cellule en cours car frequence de la cellule suivante est superieure[/COLOR]
ActiveCell.EntireRow.Delete

ElseIf ActiveCell = ActiveCell.Offset(1, 0) _
[COLOR="Red"]And ActiveCell.Offset(, 1).Value > ActiveCell.Offset(1, 1).Value[/COLOR] Then

[COLOR="Green"]'supprime la ligne de la cellule suivante car frequence de la cellule active est superieure[/COLOR]
ActiveCell.Offset(1,0).EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub

Non teste... En esperant que ca fonctionne

Bonne journee,

supression de doublons amélioré

shadoune

XLDnaute Nouveau

mutzik

XLDnaute Barbatruc

pedrag31

XLDnaute Occasionnel

Discussions similaires