Supprimer les doublons: traitement très long !!

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

shmider

XLDnaute Occasionnel
Bonjour,

En fait, je cherche à enlever les doublons qui peut y avoir dans les cellules de la colonne A. les autres doublon ne sont pas génants.

Cependant, j'ai une macro qui fait ça très bien sauf que lorsqu'on a un nombre de ligne important le temps de traitement devient très lourd !!

Comment faire pour diminuer ce temps?

Note: le sreen updating est djà desactivé !!

@+
 

Pièces jointes

Re : Supprimer les doublons: traitement très long !!

Salut,

En verifiant si la cellule du dessus est la meme ca doit etre un peu plus rapide.

Code:
Sub SupDoub()
    Dim i As Integer
    
    Application.ScreenUpdating = False
    Sheets("test1").Select
    
    For i = Range("a65536").End(xlUp).Row To 2 Step -1
        If Cells(i, 1).Value = Cells(i - 1, 1).Value Then
            Rows(i).Delete
        End If
    Next i
    
    MsgBox "Terminé !!", vbInformation

    Application.ScreenUpdating = True
End Sub
 
Re : Supprimer les doublons: traitement très long !!

Bonjour Minick,
Bonjour BOISGONTIER,

BOISGONTIER ta solution est superbe elle marche très bien! Sauf que j'aurais aimé garder les resultats dans la meme feuille (car elle sont déjà copier sur une autre) donc dans mon cas c'est pas la peine de les mettre dans la feuille "resultats".

Peux tu s'il te plait m'aider la dessus j'ai bien beau changé les noms des feuilles mais les doublons ne part plus!

Merci beaucoup et @+
 
Re : Supprimer les doublons: traitement très long !!

voir pj

Code:
Sub OrdreRespectéDictionary()
  Set MonDico = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  i = 5
  Do While Cells(i, "A") <> ""
    temp = Cells(i, "A")
    If Not MonDico.Exists(temp) Then
        MonDico.Add temp, temp
        i = i + 1
     Else
        Rows(i).EntireRow.Delete
     End If
  Loop
End Sub


JB
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

G
Réponses
4
Affichages
1 K
Gregoryen
G
O
Réponses
17
Affichages
4 K
OuiOuiNonNon
O
K
Réponses
5
Affichages
2 K
kondabalo
K
Retour