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

Guest

mutzik

XLDnaute Barbatruc

pedrag31

XLDnaute Occasionnel

Discussions similaires

supression de doublons amélioré

shadoune

Guest

mutzik

XLDnaute Barbatruc

pedrag31

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency