VBA : Supprimer les doublons




Nous voici donc sur le second article concernant le probléme des doublons dans les bases de données. La procédure suivante va nettoyer la base de tous les doublons qu'elle contient, ici nous considérons que les clés en surnombre sont placées dans  la première colonne.
Par sécurité il n'y a pas d'action dans la base de départ, le contenu de la base est stockée dans un tableau a(), puis après traitement, la nouvelle base contenue dans un tableau c() sera récupérée sur une autre feuille de calcul.
Nous utilisons bien sur l'objet Dictionary pour réaliser ce traitement, vous pouvez consulter l'article précédent si vous ne maîtrisez pas complétement cet objet.


Sub Doublons_BDD()

Dim a(), c()
Dim mondico As Object
Dim ligne, i, k As Long

  Application.ScreenUpdating = False


'va suspendre l'affichage à l'écran des travaux de la macro
'ce qui accélére son exécution le nombre de lignes dans la base pouvant être élevé

  Set mondico = CreateObject("Scripting.Dictionary")
 
  '********************************************************************
  'attention je suis sur la feuille ou se trouve ma base
  'sinon je declare un autre dico puis le dico est stockée dans le tableau
  'dim dico2 as object
  'Set dico2 = Sheets("BD")
  'a = dico2.Range("A1").CurrentRegion.Value
  '***************************************************************

 
  a = Range("A1").CurrentRegion.Value
  'La base est stockée dans le tableau a()


  ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
  ligne = 1
 
  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("BD-2").[A1].Resize(mondico.Count, UBound(a, 2)) = c

'il faut recopier le tableau c() sur la feuille de calcul "BD-2"
End Sub


Bonne lecture et bon courage pour vos adaptations...




0 commentaires:

Publier un commentaire

top