Supprimer les doublons sans tri préalable des données

Il arrive parfois que la suppresion de doublons sans tri préalable soit demandée. Je propose donc le code suivant qui, sans être très élégant, résoud le problème.

Idée 1 : Supprimer les doublons sans effectuer de tri préalable afin de conserver l'ordre des données.

Idée 2 : Option 1 -> Ne supprimer que les lignes entièrement vides (permet de conserver les données situées dans les colonnes suivantes si A est vide)
.............Option 2 -> Supprimer toutes les lignes dont la cellule de la colonne A est vide
.............Option 3 -> Ne pas supprimer les lignes vides

Idée 3 : Supprimer les doublons dans une plage présentant des lignes vides

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39

Sub LaMacro() Dim FL1 As Worksheet Dim Valeur As Variant, c As Range Dim NoLigne As Long, DerLig As Long Set FL1 = Worksheets("Feuil1") NoLigne = 1 Do If Not Cells(NoLigne, 1) = "" Then Valeur = Cells(NoLigne, 1) Do With FL1.Range("A" & NoLigne + 1, [A65536].End(xlUp)) DerLig = 0 Set c = .Find(Valeur, LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then If c.Row > NoLigne Then DerLig = c.Row c.EntireRow.Delete End If End If Set c = Nothing End With Loop While DerLig > NoLigne   Else 'Idée 2 - Option 3 : Pour conserver les lignes vides, supprimer tout le Else   'Idée 2 - Option 1 -> Condition pour ne supprimer que les lignes entièrement vides If FL1.Range("IV" & NoLigne).End(xlToLeft).Column = 1 And _ FL1.Cells(NoLigne, 1) = "" Then   'Idée 2 - Option 2 : Pour supprimer ttes les lignes dont la colonne A est vide, 'supprimer la condition ci-dessus FL1.Rows(NoLigne).Delete NoLigne = NoLigne - 1 End If End If NoLigne = NoLigne + 1 Loop While NoLigne < FL1.Range("A65536").End(xlUp).Row End Sub

---

A défaut d'un code plus élaboré

bonjour cher Ouskel'n'or


D'autres solutions dans ce lien:

http://silkyroad.developpez.com/excel/doublons/#LIV-F

Il me semble que passer par une collection serait plus rapide


bonne journée
michel

Merci Michel,
La collection est effectivement une bonne idée mais ne remplit pas les trois options que je me suis fixé.
En outre, dans la solution proposée, seules les données de la première colonne sont "collectionnées".
On pourrait bien sûr établir la collection des N° de lignes des données sans doublon plutôt que les données elles-même, puis recopier ces lignes sur une autre feuille (puisqu'il serait impossible de supprimer les doublons sans modifier les N° de ligne) etc. Enfin on perdrait toutes les lignes vides (sauf une) dont la colonne examinée serait vide pour peu qu'on souhaite ne supprimer que les lignes entièrement vides (l'une de mes options)

Par contre, je constate que nous autres, fidèles d'Office 2003, allons bien vite devenir obsolètes face aux adeptes d'Office 2007... (que je n'ai pas l'intention d'acquérir vu que je n'en ai plus aucun besoin, à moins que Microsoft ne me l'offre :mouarf:)
Merci de ton attention mais n'hésite pas à me dire si je me fourvoie en affirmant qu'en raison des options que je me suis fixé, la collection ne me conviens pas.
A+
Amicalement
Joël

Quand on veut garder l’ordre des données lors de tris successifs il suffit d’ajouter une colonne
Ordre avec pour valeur des cellules =ligne()
Et de faire un copier collage spécial valeurs sur l’ordre

Ceci n’enlève rien aux mérites de tes solutions

Merci Random,
En permettant de replacer les données dans l'ordre originel, ta solution s'inscrit effectivement dans celle proposée par AlainTech dans cette discussion maintenant dans la FAQ. Faudrait l'ajouter ;)

Bonjour,

une autre solution qui permet de supprimer les doublons sans tri consiste à construire un nouvel objet adapté à une ligne puis à lire la feuille ligne par ligne en créant un objet par ligne
Une fois cela fait, on indexe (classe) l'ensemble des objets (avec un tri rapide) et on cherche directement les doublons sur les objets. On obtient donc les lignes doublons que l'on peut ensuite supprimer facilement.
Cette méthode marche très bien mais elle est assez lente, notamment parce que l'on passe 2 fois la feuille en revue. En pratique, jusqu'à 3 - 4000 lignes, c'est jouable, ensuite,... ça dépend de l'ordi....

grimmag

Celà ne revient-il pas au même que de créer une collection ?

Si, cela revient au même que la collection à ces deux détails près:
- tu ne collectionnes pas les objets que sur la colonne A mais sur les colonnes que tu veux (en particulier, tu peux te servir de 2 ou 3 colonnes pour accélérer la recherche)
- tu indexes tes objets suivant une clé qui permet d'accélérer la recherche, par exemple par ordre alphabétique sur la clé choisie.
L'objectif est de faire un programme efficace (rapide) car il y a un grand nombre de données à traiter si on prend des tableaux à trier réalistes.

Hello grrimag,
On est ici pour trouver la meilleure solution à un problème. Or si la solution que j'ai proposée fonctionne, je suis le premier à ne pas la trouver "très" élégante (!). Je suis aussi convaincu qu'on peut trouver mieux.
Je te propose donc de rédiger le code de ta proposition (qui paraît effectivement intéressante) et on chronomètra les deux procédures à la ms près. Comme la mienne est très lourde elle aussi, on avisera pour savoir s'il faut trouver une troisième solution.
"A vos marque ! .... "

A+ et merci de tes interventions.

Hello,

j'essaie de mettre ça au point dès que possible mais j'ai besoin d'une info au préalable: est-ce que les pointeurs existent en VBA? si oui, comment on fait pour en avoir 1? et quelles sont les principales commandes/syntaxes pour s'en servir? le but c'est d'utiliser des listes chainées d'objets.

Merci

Bonjour

Vous avez pensé au SQL, il devrait être possible (dans la mesure ou la feuille est bien structurée) de faire une requête qui permet de prendre des lignes distinctes, et copier le résultat dans une autre feuille.

Je n'ai pas trop de temps pour l'instant, mais je vais tenter l'expérience, pourrais-t-on avoir un fichier exemple pour comparer avec une même base ?

Michel, si tu es dans le coin, que penses tu d'une solution avec le SQL, comme je sais que tu sais l'utiliser sous Excel.

Starec

En sql cela fonctionne bien évidemment

J’ai testé ceci avec ms query

3 colonnes avec labels data1, data2, data3
j’ai complété le tableau avec des entiers au hasard
j’ai nommé l’ensemble et une centaine de lignes vides mabase

à ce stade il faut sauvegarder

et faire données données externes créer une requête sources de données excel

et choisir le classeur

à ce stade il reconnaît mabase

on sélectionne toutes les colonnes
puis faire suivant jusqu’au dernier écran
et choisir modifier la requête dans msquery

on fait alors affichage propiétés de la requête valeurs distinctes seulement
enregistrer la requête puis renvoyer les données vers excel
choisir la destination

les données sont présentes sans doublon


il reste à insérer une nouvelle valeur dans mabase et faire actualiser elle va apparaître si ce n’est pas un doublon sinon rien ne se passe

la fonction suivante permet de lire le sql

Code:

---

1 2 3 4 5

Function vv() Dim msql As QueryTable Set msql = Workbooks("tsql.xls").Worksheets(3).QueryTables(1) MsgBox (msql.CommandText) End Function

---

et querytable est accessible en écriture ce qui permet de disposer de
tout le sql sous un classeur standard
avec paramètres multiples ce qui étend les possibilités dans les phases critiques où une solution facile n'est pas évidente

Je n'ai pas replacé cette discussion dans Contribuez mais Youpi ! Avec les collections, j'ai même trouvé mieux que le but que je m'étais fixé puisque le code que je propose permet de vérifier les cellules de toutes les colonnes de chaque ligne. (ici)
Merci à tous, comme dab', l'idée de Michel d'utiliser les collections était la bonne ;)

j'ai pas trop regarder tout, mais une approche comme

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

Sub ChercheDoublon()   Dim MaPlage As Range, plRed As Range, macell As Range, Recup As Variant   'plage continue Set MaPlage = ThisWorkbook.Worksheets(1).Range("A1:E30") 'ou discontinue 'Set MaPlage = Application.Union(ThisWorkbook.Worksheets(1).Range("A1:A30"), ThisWorkbook.Worksheets(1).Range("C1:C30"), ThisWorkbook.Worksheets(1).Range("E1:E30")) For Each macell In MaPlage.Columns(1).Cells Set plRed = MaPlage.ColumnDifferences(macell) plRed.EntireRow.Hidden = True Set plRed = MaPlage.SpecialCells(xlCellTypeVisible) If plRed.Rows.Count > 1 Or plRed.Areas.Count > MaPlage.Areas.Count Then 'bon la c'est un peu à deux balles 'il doit y avoir plus mieux 'mais ce soir j'ai le cerveau lisse Recup = MaPlage.Rows(plRed.Rows(1).Row).Value plRed.ClearContents MaPlage.Rows(plRed.Rows(1).Row).Value = Recup End If MaPlage.EntireRow.Hidden = False Next macell   End Sub

---

Ca le ferait pas ?

Hello Bidou,
Ça laisse bien des trous mais effectivement, c'est rapide. Pour les trous, je pense que c'est dû à l'heure tardive ;) En utilisant for each... tu ne peux pas les éviter, sinon t'as tout faux... Mais tu auras sûrement un autre idée dans la nuit pour supprimer les lignes vides sans nouvelle boucle :mouarf:
Alors bonne nuit
A+

bonjour à vous ... ;o)

Citation:

---

pour supprimer les lignes vides sans nouvelle boucle

---

Code:

---

1 2 3 4 5 6 7

'Supprime la ligne complète si les cellules de 'la colonne A sont vides. Dim x As Long   x = Range("A65536").End(xlUp).Row Cells.Range("A1:A" & x). _ SpecialCells(xlCellTypeBlanks).EntireRow.Delete

---

bonne journée
michel

Citation:

---

Envoyé par ouskel'n'or

Hello Bidou,
Ça laisse bien des trous mais effectivement, c'est rapide. Pour les trous, je pense que c'est dû à l'heure tardive ;) En utilisant for each... tu ne peux pas les éviter, sinon t'as tout faux... Mais tu auras sûrement un autre idée dans la nuit pour supprimer les lignes vides sans nouvelle boucle :mouarf:
Alors bonne nuit
A+

---

C'est surtout que j'ai pas trop compris tes règles de suppression de trous.
Si c'est juste pour virer les lignes complètement vides, le même principe va fonctionner

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28

Sub ChercheDoublon()   Dim MaPlage As Range, plRed As Range, macell As Range, Recup As Variant   Application.ScreenUpdating = False 'plage continue Set MaPlage = ThisWorkbook.Worksheets(1).Range("A1:E30") 'ou discontinue 'Set MaPlage = Application.Union(ThisWorkbook.Worksheets(1).Range("A1:A30"), ThisWorkbook.Worksheets(1).Range("C1:C30"), ThisWorkbook.Worksheets(1).Range("E1:E30")) For Each macell In MaPlage.Columns(1).Cells Set plRed = MaPlage.ColumnDifferences(macell) plRed.EntireRow.Hidden = True Set plRed = MaPlage.SpecialCells(xlCellTypeVisible) If plRed.Rows.Count > 1 Or plRed.Areas.Count > MaPlage.Areas.Count Then plRed.Cells(1).EntireRow.Hidden = True plRed.SpecialCells(xlCellTypeVisible).ClearContents End If MaPlage.EntireRow.Hidden = False Next macell 'obligatoire si plage discontinue Set MaPlage = ThisWorkbook.Worksheets(1).Range("A1:E30") MaPlage.Rows(2).EntireRow.Insert Set plRed = MaPlage.ColumnDifferences(MaPlage.Cells(2, 1)) plRed.EntireRow.Hidden = True MaPlage.SpecialCells(xlCellTypeVisible).EntireRow.Delete xlShiftUp MaPlage.Worksheet.Cells.EntireRow.Hidden = False   End Sub

---