Discussion :

[ouskel'n'or]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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é

[SilkyRoad]

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

[ouskel'n'or]

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 )
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

[random]

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

[ouskel'n'or]

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

[grrimag]

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

[ouskel'n'or]

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

[grrimag]

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.

[ouskel'n'or]

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.

[grrimag]

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

[Invité]

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

[random]

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

[random]

la fonction suivante permet de lire le sql

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[ouskel'n'or]

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

[bidou]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 ?

[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
Alors bonne nuit
A+

[SilkyRoad]

bonjour à vous ... ;o)

pour supprimer les lignes vides sans nouvelle boucle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[bidou]

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
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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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