supression de doublons amélioré

[shadoune]

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]

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]

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:

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,