Supprimer les doublons d'une liste

[romainchu78]

Bonjour a tous le forum,

Je souhaiterais filtrer une liste de pieces classees en ligne sur la colonne A. mon probleme est que j'ai mis au point une macro pour supprimer les doublons mais la liste a plus de 28000 lignes donc ca me beaucoup trop de temps.
avez vous un code pour trier plus vite et supprimer les doublons?
merci par avance,

 

[Temjeh]

Re : Supprimer les doublons d'une liste

Bonjour

Voici une idée qui supprime la ligne du doublon en col A mais je ne sais pas pour la vitesse:

Dim i As Integer
Application.ScreenUpdating = False

For i = Range("a65536").End(xlUp).Row To 1 Step -1
    If Application.CountIf(Range(Cells(i, 1), "A1"), Cells(i, 1)) > 1 Then
        Rows(i).Delete
    End If
Next i
Application.ScreenUpdating = True

A++
Ce lien n'existe plus

 

[tora]

Re : Supprimer les doublons d'une liste

Bonjour a tous le forum,

Je souhaiterais filtrer une liste de pieces classees en ligne sur la colonne A. mon probleme est que j'ai mis au point une macro pour supprimer les doublons mais la liste a plus de 28000 lignes donc ca me beaucoup trop de temps.
avez vous un code pour trier plus vite et supprimer les doublons?
merci par avance,

Slt,

une éventuelle proposition ....
mais peut-on nettoyer la colonne A
avant d'y replacer la liste propre ?

1/ extraction des données en A
2/ filtrage
3/ nettoyage complet de A ( A vide )
3/ depot en A de la nouvelle liste

Selon réponse idée éventuelle ...

@+

PS :
selon la solution proposée précédemment ta ligne
de doublon est supprimée en entier, est-ce le but ?

PS2: utilise tu un filtre auto ?

 

[romainchu78]

Re : Supprimer les doublons d'une liste

Merci a vous deux. Temjeh ton code fonctionne tres rapidement. merci a tous.

 

[tora]

Re : Supprimer les doublons d'une liste

Merci a vous deux. Temjeh ton code fonctionne tres rapidement. merci a tous.

attention au filtre auto !
j'ai deja eu des erreurs de lignes avec cette connerie ...

Si tu en utilise, tu as des erreurs potentielles avec

range().end(xlup)

sur ce @ciao ...

 

[ROGER2327]

Re : Supprimer les doublons d'une liste

Bonjour à tous

Ce code, placé dans le module de la feuille à nettoyer, élimine les doublons de la colonne A et renvoie le tableau nettoyé dans une nouvelle feuille.

Sub sup_doublons()
Dim i As Long, j As Long, c As Long, vCalc As String
Dim oDat(), UB1 As Long, UB2 As Long, oPropre(), vDat
   vCalc = Application.Calculation
   oDat = Me.[A1].CurrentRegion.Value
   oDat = Application.Transpose(oDat)
   UB1 = UBound(oDat, 1): UB2 = UBound(oDat, 2)
   ReDim oPropre(1 To UB1, 1 To UB2)
   For i = 1 To UB1: oPropre(i, 1) = oDat(i, 1): Next i
   c = 1
   For i = 1 To UB2
      vDat = oDat(1, i)
      For j = 1 To c
         If oPropre(1, j) = vDat Then Exit For
      Next j
      If j > c Then
         c = j
         For j = 1 To UB1
            oPropre(j, c) = oDat(j, i)
         Next j
      End If
   Next i
   Erase oDat
   ReDim Preserve oPropre(1 To UB1, 1 To c)
   oPropre = Application.Transpose(oPropre)
   vCalc = Application.Calculation
   Application.Calculation = xlCalculationManual
   Sheets.Add after:=Me
   Application.ScreenUpdating = False
   With ActiveSheet
      .Range(.Cells(1, 1), .Cells(c, UB1)).Value = oPropre
   End With
   Erase oPropre
   Application.Calculation = vCalc
   Application.ScreenUpdating = True
End Sub

Plus rapide que le code de Temjeh.
Sur un tableau de 28000 lignes et 9 colonnes comportant environ une moitié de lignes identiques :
Code Temjeh : 130 secondes.
Ce code : 48 secondes.​

ROGER2327
__________________
Note : le choix de Temjeh de déclarer

Dim i As Integer

limite à 32700 et des poussières le nombre de lignes suceptibles d'être traitées. Il vaudrait mieux déclarer

Dim i As [B]Long[/B]

 

[BOISGONTIER]

Re : Supprimer les doublons d'une liste

Bonsoir,

0,23s pour 10.000 éléments

Voir PJ

Sub SupDoublons()
    Application.ScreenUpdating = False
    Set f1 = Sheets("BD")
    n = f1.Range("A65000").End(xlUp).Row
    a = f1.Range("A2:C" & n).Value
    Set mondico = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a)
      If Not mondico.exists(a(i, 1)) Then mondico.Add a(i, 1), i
    Next
    Dim c()
    n = mondico.Count
    ReDim c(1 To n, 1 To UBound(a, 2))
    ligne = 1
    For Each i In mondico.items
      For k = 1 To UBound(a, 2): c(ligne, k) = a(i, k): Next k
      ligne = ligne + 1
    Next i
    Sheets("resultat").[A2].Resize(n, UBound(a, 2)) = c
End Sub

JB
Formation Excel VBA JB

 

[ROGER2327]

Re : Supprimer les doublons d'une liste

Bonsoir à tous

Il est vrai qu'on ne pense pas assez à emprunter au langage de script dans les procédures en VBA.
Avec 10000 lignes sur 9 colonnes, j'obtiens 1,3 secondes avec la procédure de BOISGONTIER et 8,2 secondes avec la mienne. Le gain est appréciable !
Pensez toutefois à modifier la procédure de BOISGONTIER à chaque fois que le nombre de colonnes du tableau change, et à reporter les intitulés de colonnes dans la feuille de résultat.​

Bonne nuit !
ROGER2327

 

[BOISGONTIER]

Re : Supprimer les doublons d'une liste

Bonjour,

Sub SupDoublons()
    Application.ScreenUpdating = False
    Set f1 = Sheets("BD")
    a = f1.Range("A1").CurrentRegion.Value
    Set mondico = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a)
      If Not mondico.exists(a(i, 1)) Then mondico.Add a(i, 1), i
    Next
    Dim c()
    ReDim c(1 To mondico.Count, 1 To UBound(a, 2))
    ligne = 1
    For Each i In mondico.items
      For k = 1 To UBound(a, 2): c(ligne, k) = a(i, k): Next k
      ligne = ligne + 1
    Next i
    Sheets("resultat").[A1].Resize(mondico.Count, UBound(a, 2)) = c
End Sub

JB