Macro : Suppression de doublons 'rapide"

  • Initiateur de la discussion Initiateur de la discussion Luigi13
  • Date de début Date de début

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 !

L

Luigi13

Guest
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
 
Re : Macro : Suppression de doublons 'rapide"

Re,

Un méthode possible à adapter
Code:
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+
 
Dernière modification par un modérateur:
Re : Macro : Suppression de doublons 'rapide"

Bonjour,

0,23 sec pour 10.000 éléments


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

Code:
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
 
- 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
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

G
Réponses
9
Affichages
1 K
G
D
Réponses
9
Affichages
2 K
S
Réponses
4
Affichages
2 K
stage_ferrit
S
B
Réponses
2
Affichages
1 K
bonjourdoc
B
N
Réponses
2
Affichages
7 K
N
V
Réponses
3
Affichages
840
P
Réponses
4
Affichages
1 K
Pierrot
P
Retour