VBA accelérer une boucle

Bonsoir au forum,

Pour supprimer des doublons dans une colonne de 1050 lignes,

J'ai mis un NB.SI sur la colonne à coté, et bidouillé cette macro :

    Do While ActiveCell <> ""
        Do While ActiveCell.Offset(0, 1) > 1
                 'ActiveCell.EntireRow.Delete
                Range(ActiveCell, ActiveCell.Offset(0, 1)).Delete Shift:=xlUp
        Loop
            ActiveCell.Offset(1, 0).Activate
    Loop

au final, il reste 35 lignes (sans doublons), mais la macro mets 2 minutes !

ou 1 minute, 20 secondes en supprimant la ligne entière.

il y a surement une meilleure façon de faire. + rapide ?

merci de votre aide

amicalement

Claude.

Bonsoir claude,

Vois ce lien : https://www.excel-pratique.com/forum/viewtopic.php?t=3487 qui devrait t'aider.

Sinon donne la colonne en question ou ton fichier.

Amicalement

Dan

Edit Dan :

Un code pour faire cela en colonne B

Sub EliminerDoublons()
'Macro par @+Thierry - Modifiée par Dan le 07/04/08
Dim i As Integer
With activesheet
    .UsedRange.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess 'trie la plage
        For i = .Range("B65536").End(xlUp).Row + 1 To 2 Step -1 'colonne B
        If .Range("B" & i) = Range("B" & i + 1) Then
        .Range("B" & i).EntireRow.Delete
        End If
        Next
End with
End Sub

Dan

Bonsoir,

autre méthode, si tu ne dois conserver que les données uniques de la colonne A :

Sub doublon()
Dim Unique As Object, Cel As Range
Set Unique = CreateObject("Scripting.Dictionary")
    For Each Cel In Range("A2:A" & [A65000].End(xlUp).Row)
        If Not Unique.Exists(Cel.Value) Then Unique.Add Cel.Value, Cel.Value
    Next Cel
    Range("A2:A" & [A65000].End(xlUp).Row).EntireRow.Delete
    Range("A2:A" & Unique.Count + 1) = Application.Transpose(Unique.items)
End Sub

merci Dan,

ton 1er lien macro "regrouper est de loin là + rapide moins de 8 secondes

mais serait-il possible de ne supprimer que dans la colonne au lieu de supprimer la ligne entière ?

Claude.

édit pas encore tester ton dernier message

re,

la dernière "Sub doublon" est pratiquement instantanée !

j'ai juste changer cette ligne pour ne pas toucher aux colonnes adjacentes :

    'Range("A2:A" & [A65000].End(xlUp).Row).EntireRow.Delete

rempacée par :

    Range("A2:A" & [A65000].End(xlUp).Row).Delete Shift:=xlUp

le résultat est impressionnant !

je mets çà en place demain matin.

encore merci Dan, et bonne nuit

Claude.

edit: pardon felix, je n'avais pas fait attention au pseudo.

merci à tous les deux.

Salut le forum

Claude, tu n'oublies pas une petite formalité ...

• Dès que votre problème est résolu, merci de le marquer en tant que [Résolu]
  grâce à l'utilitaire se trouvant en bas de page, aperçu :

re,

Claude si tu te rappelles mon commentaire au sujet des crochets [], remplace les par "Range", tu gagneras encore un petit peu de temps.

N'oublie pas le commentaire de Myta aussi.... cela aide la gestion du forum.

Bonne journée

Dan

Bonjour à tous,

D'abord, merci à tous de m'aider sur ce coup là .

- je reviens sur la macro de felix, comme je l'ai légèrement modifiée, il doit y avoir un

ajustement à faire ! mais je ne vois pas !

explication :

https://www.excel-pratique.com/~files/doc/doublon_essai1.xls

amicalement

Claude.

Bonjour,

le souci vient justement parce que tu commences en ligne 4...

dans cette ligne :

    Range("A4:A" & Unique.Count + 1) = Application.Transpose(Unique.items)

on compte le nombre d'items dans l'object "Unique"

Et on transpose de la cellule A4 à la cellule A & nombre d'items +1 : ceci est valable, si tu commences en ligne 2

Comme tu commences en ligne 4, il faut remplacer par ceci :

    Range("A4:A" & Unique.Count + 3) = Application.Transpose(Unique.items)

re,

je crois avoir trouver l'explication :

en remplaçant :

   Range("A4:A" & Unique.Count + 1) = Application.Transpose(Unique.items)

par :

    Range("A4:A" & Unique.Count + 3) = Application.Transpose(Unique.items)

et je mettrait résolu quand se le sera vraiment.

amicalement

Claude.

re,

J'ai donc opté pour le code à felix qui est vraiment instantané (liste de 1000 lignes)

Je ne comprends pas comment çà marche, mais je le mets soigneusement de coté.

les autres codes aussi.

merci Dan et felix

Cordialement

Claude.