Macro : Suppression de doublons 'rapide"

[Luigi13]

Bonjour à tous, je cherche une solution vba me permettant de supprimer les doublons d'une plage de données de façon rapide.
J'ai essayé plusieurs code et tous me figent l'ordinateur ou alors mettent au moins 10 min.
Le seul code que j'ai trouvé qui me permet d'aller vite est celui de MDF.
Le problème c'est que j'aimerai affecté le code à un bouton, et celui de MDF étant crypté par mdp je ne peux pas.

Je m'explique, j'ai une plage nommée 'bd' et j'aimerai que lorsqu'un doublon est reconnut dans la colonne A, que le code m'efface la ligne doublonnée.
J'ai entendu de méthode par procédure qui irait plus vite, mais étant novice en la matière tout cela reste vague pour moi..!
Si vous pouviez m'aider,ce serait sympa !
Merci à vous

 

[Compte Supprimé 979]

Re : Macro : Suppression de doublons 'rapide"

Bonjour,

Une petite recherche sur google
Ce lien n'existe plus

Tu devrais trouver ton bonheur

A+

 

[Luigi13]

Re : Macro : Suppression de doublons 'rapide"

Mais j'ai trouvé plusieurs codes vba qui me le font mais ce que je cherche c'est la 'fameuse' méthode qui me permet de le faire en quelques secondes!

 

[Compte Supprimé 979]

Re : Macro : Suppression de doublons 'rapide"

Re,

Un méthode possible à adapter

Sub SupDoublons()
  Dim DLig As Long
  DLig = Range("A" & Rows.Count).End(xlUp).Row
  ' Utilisation du filtre avancé
  With Range("A1:A" & DLig)
    .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("Z1"), Unique:=True
    .Clear  ' Effacer les données de la colonne contenant les doublons
  End With
  ' Coller les valeurs uniques
  DLig = Range("Z" & Rows.Count).End(xlUp).Row
  Range("Z1:Z" & DLig).Cut Destination:=Range("A1")
End Sub

0,0625 sec pour 10.000 éléments

A+

 

[BOISGONTIER]

Re : Macro : Suppression de doublons 'rapide"

Bonjour,

0,23 sec pour 10.000 éléments


http://boisgontierjacques.free.fr/fichiers/SupDoublonsDict.xls

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

JB
Formation Excel VBA JB

 

[Luigi13]

Re : Macro : Suppression de doublons 'rapide"

Merci bcp! sympa d'avoir prit du temps pour me répondre , ca ma été tres utile ! bonne journée