VBA : Repérer les doublons

Nous allons consacrés deux articles à la problématique des doublons à l'intérieur
des bases de données. Les doublons pouvant se définir comme deux enregistrement rigoureusement identiques dans une base, les valeurs de tous les champs de l'enregistrement sont communs, ou alors seulement les données d'une colonne  (généralement la colonne qui doit servir de clé unique) sont communes (Numéro de client, E-mail...). Enfin par doublons il faut entendre que la valeur n'est pas forcément doublée, elle peut être triplée etc...

En général nous souhaitons pouvoir repérer les informations présentes en surnombre, cela fera l'objet de cet article. La suppression définitive des enregistrements redondants sera l'objet de l'article suivant.
Il existe plusieurs méthodes et techniques pour intervenir sur cette problématique, j'ai notament montré dans une vidéo du 12/04/2012 comment travailler grâce à la fonction =nb.si() et la commande Validation des données de l'onglet Données.
 En terme de programmation le bon réflexe est de penser Collection et Dictionary. Le premier objet étant réputé très lent en terme de résultat, nous allons ici présenter l'objet Dictionary.
 Cet objet associe des valeurs (nommées Items) à des clés (Keys). Il s'agit en fait d'un tableau à une dimension dont on accède aux éléments par une clé et non par un indice.

Soit un Dictionnaire MonDico :

Keys	Items
bleu	2
rouge	6
vert	9
blanc	4
noir	7

 
Les métodhes et propriétés suivantes peuvent être associés au Dictionnaire :

Add clé,élément	Ajoute une clé et la valeur associée
Exists(clé)	Teste l'existence d'une clé
Tbl=Items	Donne dans un tableau les éléments
Tbl=Keys	Donne dans un tableau les clés
Remove (clé)	Suprime la clé
Removeall	Supprime tous les éléments
Count	Donne le nombre d'éléments
Item(clé) =valeur	Modifie la valeur de la clé
Item(clé)	Donne la valeur associée à la clé
CompareMode=vbTextCompare	Ignore la casse

 
Attention ! Vous ne pourrez pas utiliser l'objet Dictionary si vous n'avez pas chargé la bibliothéque "Scripting". Cocher la ligne "MicroSoft Scripting Runtime" dans la commande Outils / références... de votre éditeur VBA.

La procédure ci dessous va vous permettre de vous familiariser avec les manipulations de base en matière de dictionnaire. Pour ceux qui veulent étudier cette question de manière plus approfondie, lisez l'excellent article de Jacques Boisgontier.

Option Explicit
Option Base 1
Sub ListeDictionnaire()

Dim mondico As Object, cle
Set mondico = CreateObject("Scripting.Dictionary")
'déclaration classique de l'objet dictionnaire notez toutefois le ,cle
'qui servira de variable (type range) pour la colonne clé
Dim TabC()
'tableau non typé et non dimensionné pour recevoir les clés du dictionnaire
Dim TabI()
'tableau non typé et non dimensionné pour recevoir les items du dictionnaire

'*** Les trois méthodes permettant l'association des items aux clés ***
  mondico.item("bleu") = 2
  mondico.item("rouge") = 6
  mondico("vert") = 9
  If Not mondico.Exists("violet") Then mondico.Add "blanc", 4
  mondico.item("noir") = 7
 
 '*** vérifions l'item pour une clé ***
  cle = "noir"
  MsgBox cle & " : " & mondico.item(cle), vbOKOnly + vbInformation
 
  '*** vérifions tous les items de  toutes les clés ***
  For Each cle In mondico.Keys
     MsgBox cle & " : " & mondico.item(cle), _
     vbOKOnly + vbInformation, vbOKOnly + vbInformation, _
     " Clés + Item : "
  Next cle
 
  '*** pour passer des éléments clés et items dans des tableaux ***
  TabC = mondico.Keys
  TabI = mondico.Items
  MsgBox TabC(3) & " : " & TabI(3), _
  vbOKOnly + vbInformation, vbOKOnly + vbInformation, _
  " Clés + Item : "
   
 '*** faire des Statistiques sur les items ***
MsgBox "Total : " & Application.Sum(mondico.Items) _
 & " - Moyenne : " & Application.Average(mondico.Items), _
 vbOKOnly + vbInformation, "Statistiques : "
End Sub

Venons en maintenant au probléme de repérage des doublons, analysons ensemble la procédure suivante qui va repérer par un code couleur touts les doublons de ma base sur la colonne que j'ai choisi comme étant la clé de mon dictionnaire.

Sub Doublons_repere()

Dim mondico As Object, cle
Set mondico = CreateObject("Scripting.Dictionary")
 
Columns("A:A").Select
Selection.Interior.ColorIndex = xlNone
'nous travaillons donc sur la colonne A
'pour chaque clé de A2 jusqu'à la fin de la colonne
  For Each cle In Range("a2", Range("a2").End(xlDown))
  'on va affecter à chaque clé du dictionnaire un item = à 1
     mondico.item(cle.Value) = mondico.item(cle.Value) + 1
     'si la clé est présente 2 fois ou plus on aura un item > à 1
  Next cle
 
  For Each cle In Range("a2", Range("a2").End(xlDown))
   'reste alors le coloriage du fond des cellules pour les item
      'présents 2 fois ou plus
    If mondico.item(cle.Value) > 1 Then cle.Interior.ColorIndex = 6
  Next cle
End Sub

Bonne lecture et bon courage pour vos adaptations...

 

Partager |