Recherche de doublons sur 2 colonnes différentes VBA

Bonjour au forum,

J'aimerais mettre en évidence d'éventuels doublons de 2 colonnes différentes (B et AE), avec pour chaque doublon une couleur différente afin de les repérer plus facilement.

J'ai testé plusieurs codes mais à force je m'embrouille plus qu'autre chose...

Option Explicit

Const coCod = "B"   ' colonne code
Const coSta = "AE"   ' colonne statut
Const lideb = 2     ' premiere ligne des données
Const vert = 50     ' code couleur
Const rouge = 3     ' idem

Private Sub CommandButton1_Click()

Dim li As Long, lifin As Long, cod As Long, sta As String, lili As Long
Dim obj As Object, plage As Range
' inhibe la maj de la feuille après chaque modification
Application.ScreenUpdating = False
' derniere ligne non vide de la colone cocod
lifin = Range(coCod & Rows.Count).End(xlUp).Row
' boucle sur les lignes en partant de la dernière (à cause des suppressions eventuelles de lignes
For li = lifin To lideb + 2 Step -1
  ' plage où on va rechercher le code cod
  Set plage = Range(coCod & lideb & ":" & coCod & li - 1)
  ' code et statut ligne i
  cod = Range(coCod & li).Value
  sta = Range(coSta & li).Value
  ' recherche cod dans plage
  Set obj = plage.Find(cod, , , xlWhole)
  ' si cod est trouvé
  If Not obj Is Nothing Then
    ' on recupere sa ligne
    lili = obj.Row
    ' si le statut ligne lili = statut ligne i alors on supprime la ligne li
    If Range(coSta & lili).Value = sta Then
      Rows(li).Delete
    ' sinon on met en rouge la ligne lili et en vert la ligne li
    Else
      Range(coCod & lili & ":" & coSta & lili).Font.ColorIndex = rouge
      Range(coCod & li & ":" & coSta & li).Font.ColorIndex = vert
    End If
  End If
Next li
' activation de la maj de la feuille
Application.ScreenUpdating = True

End Sub

Une idée...?

Nico.

Bonjour,

Pas sûr de savoir t'aider (d'autres y arriveront) mais,

pensez à joindre un fichier pour faciliter la compréhension du problème et augmenter les chances de vous faire aider

Un exemple de même présentation court et anonymisé suffit

Hello,

Regarde sur ce lien il y'a tout ce que tu cherche :

http://boisgontierjacques.free.fr/pages_site/Doublons.htm

Au besoin j'ai adapter le code que tu cherche chez moi pour l'un de mes job, je t'ai modifié mon code pour qu'il commence à la ligne 1, teste le normalement, ça tu pourra comparer n'importe quel colonne à partir de la ligne 1 :

'Bouton - Comparaison de 2 colonnes pour recherche doublon

'SOMMAIRE
'1. Déclaration variable
'2. Inputbox de choix de colonne
'3. Définition des variables
'4. DésActivation du raffraichissement pour accélération de la vitesse
'5. Comparaison doublons
'6. Activation du raffraichissement pour accélération de la vitesse
'7. Message d'indication de fin de traitement

'_______________________________________________________________________________________
'Comparaison par la méthode Dictionary, du site : http://boisgontierjacques.free.fr/pages_site/Doublons.htm
'Un objet Dictionary est l'équivalent d'un tableau associatif PERL. Les éléments, pouvant correspondre à n'importe quelle forme de données, sont stockés dans le tableau.
'Chaque élément est associé à une clé qui lui est propre. La clé est utilisée pour extraire un élément individuel et correspond généralement à un nombre entier ou à une chaîne,
'mais peut être n'importe quelle information à l'exception d'un tableau.
'_______________________________________________________________________________________

'----------------------------------------------------------------------------------------------------------------------------------------------
'1. Déclaration variable
'1.1 variables Pour connaitre la 1er cellule du tableur à traiter
Dim Ligne_BarTab As Double
'1.2 variables Pour connaitre la dernière cellule du tableur à traiter
Dim Fin_excel As Double
'1.3 variable pour connaitre la fin de la colonne de la plage 1
Dim Fin_col1 As Double
'1.4 variable pour connaitre la fin de la colonne de la plage 2
Dim Fin_col2 As Double
'1.5 variable pour nb doublon par comparaison colonne pour message box
Dim Compteur_Doublon2col As Double
'----------------------------------------------------------------------------------------------------------------------------------------------

'----------------------------------------------------------------------------------------------------------------------------------------------
'2. Inputbox de choix de colonne
'InputBox à User pour entrer la lettre de colonne à comparer / inputbox = retourne la lettre de colonne à traiter
On Error GoTo Error_Inputbox:
'2.1 COL_COMPARE1 Retourne la lettre de la colonne où se trouve les valeurs groupées
COL_COMPARE1 = InputBox("Sous-module de comparaison de doublon colonnes." & Chr(10) & Chr(10) & _
"La comparaison peut se faire dans toute les colonnes, mais ne débutera qu'à la ligne 13." & Chr(10) & _
"> Indiquer la première colonne à comparer.", "RAPPROCHEMENT : COMPARAISON DOUBLONS COLONNES", "Veuillez indiquer la lettre de colonne")
'2.2 COL_COMPARE2 Retourne la lettre de la colonne où se trouve le nombre de groupement
COL_COMPARE2 = InputBox("Sous-module de comparaison de doublon colonnes." & Chr(10) & Chr(10) & _
"La comparaison peut se faire dans toute les colonnes, mais ne débutera qu'à la ligne 13." & Chr(10) & _
"> Indiquer la première colonne à comparer.", "RAPPROCHEMENT : COMPARAISON DOUBLONS COLONNES", "Veuillez indiquer la lettre de colonne")
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'2.E Process gestion d'erreur de l'inputbox Error_Inputbox
Error_Inputbox:
If Err Then 'Si erreur seulement alors
Exit Sub 'Sort de la sub et laisse l'userform du set outils de rappro ouvert
End If
'----------------------------------------------------------------------------------------------------------------------------------------------

'----------------------------------------------------------------------------------------------------------------------------------------------
'3. Définition des variables
On Error GoTo Error_variable:
'3.1 Définition variable Ligne_BarTab à Ligne de départ du traitement à la ligne 13
Ligne_BarTab = Range("A1").Row
'3.2 Définition variable Fin_excel sur la fin du tableur excel pour ne pas faire des recherche à zéro, controle de sécurité repris dans point suivant
Fin_excel = Range("XFC" & Ligne_BarTab).End(xlDown).Row 'Va en bas du tableur pour prendre la dernière ligne utilisé de la version excel à partir d'une colonne non utilisé comme la XFC
Fin_excel = Range(COL_COMPARE1 & Fin_excel).End(xlUp).Row 'De la fin retourne jusqu'à la 1er cellule pleine rencontré en direction du haut et prend le numéro de ligne
'3.2+ Contrôle SI Fin tableur valeur groupé ramène à la ligne de barre titre, alors tableau vide et arrêt de la sub
If Fin_excel < Ligne_BarTab Then Exit Sub
'3.3 Définition de la dernière ligne utilisé de la plage 1
Fin_col1 = Range("XFC" & Ligne_BarTab).End(xlDown).Row
Fin_col1 = Range(COL_COMPARE1 & Fin_col1).End(xlUp).Row
'3.4 Définition de la dernière ligne utilisé de la plage 2
Fin_col2 = Range("XFC" & Ligne_BarTab).End(xlDown).Row
Fin_col2 = Range(COL_COMPARE2 & Fin_col2).End(xlUp).Row
'3.5. Création d'un objet Dictionaire
Set OBJECT_DICTIONARY = CreateObject("Scripting.Dictionary")
'3.6. Variable couleur, dont les valeurs sont contenues dans un tableau, variable de la méthode colorindex pour plus de couleurs changer de méthode
couleurs = Array(3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56)
'3.7. Définition du contenu de la plage 1, suivant choix colonne 1
Set PLAGE1 = Range(COL_COMPARE1 & Ligne_BarTab, COL_COMPARE1 & Fin_col1)
'3.8. Définition du contenu de la plage 2, suivant choix colonne 2
Set PLAGE2 = Range(COL_COMPARE2 & Ligne_BarTab, COL_COMPARE2 & Fin_col2)
'3.9. Regroupement des colonne est mise en color blanc vide
Union(PLAGE1, PLAGE2).Interior.ColorIndex = xlNone
'3.10 Définition Compteur_Doublon2col sur 0 pour valeur départ
Compteur_Doublon2col = 0
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'3.E Process gestion d'erreur de variable Error_variable
Error_variable:
If Err Then 'Si erreur seulement alors
Exit Sub 'Sort de la sub et laisse l'userform du set outils de rappro ouvert
End If
'----------------------------------------------------------------------------------------------------------------------------------------------

'----------------------------------------------------------------------------------------------------------------------------------------------
'4. DésActivation du raffraichissement pour accélération de la vitesse
Application.ScreenUpdating = False
Application.EnableEvents = False
'----------------------------------------------------------------------------------------------------------------------------------------------

'----------------------------------------------------------------------------------------------------------------------------------------------
'5. Comparaison doublons
On Error GoTo Error_comparaison:
'5.1 Indexation des données de la plage 1 dans l'objet dictionnaire pour servir de base de comparaison
For Each C In PLAGE1
   OBJECT_DICTIONARY.Item(C.Value) = OBJECT_DICTIONARY.Item(C.Value) & C.Row & "-"
Next C
'5.2 Comparaison colonne plage 2 et recherche de doublons à partir de l'objet dictionnaire comprenant les données de la plage 1
For Each C In PLAGE2
   '5.2.1 SI cellule item plage 2 en cours Renvoie la valeur True si une clé spécifiée existe dans l'objet Dictionary
   If OBJECT_DICTIONARY.exists(C.Value) Then
      'Application.Match expression.Match(Arg1, Arg2, Arg3)
      'Renvoie la position relative d'un élément dans une matrice, qui correspond à une valeur spécifiée dans un ordre spécifié.
      'Arg1    Valeur_cherchée - valeur que vous utilisez pour rechercher la valeur souhaitée dans un tableau.
      'Arg2    Matrice_recherche - plage de cellules contiguës contenant des valeurs de recherche possibles. Matrice_recherche doit être une matrice ou une référence à une matrice.
      'Arg3    Type - nombre -1, 0 ou 1. Type spécifie la manière dont Microsoft Excel recherche valeur_cherchée dans matrice_recherche.
      'Valeur_cherchée peut être une valeur (nombre, texte ou valeur logique) ou une référence de cellule à un nombre, du texte ou une valeur logique.
      'Si type prend la valeur 1, la fonction MATCH recherche la plus grande valeur qui est inférieure ou égale à valeur_cherchée. Matrice_recherche doit être placée dans l'ordre croissant : ...-2, -1, 0, 1, 2, ..., A-Z, FALSE, TRUE.
      'Si type prend la valeur 0, la fonction MATCH recherche la première valeur qui est exactement égale à valeur_cherchée. Matrice_recherche peut se trouver dans un ordre quelconque.
      'Si type prend la valeur -1, la fonction MATCH recherche la plus petite valeur qui est supérieure ou égale à valeur_cherchée. Matrice_recherche doit être placée dans l'ordre croissant : TRUE, FALSE, Z-A, ...2, 1, 0, -1, -2, ..., etc.
      'Si type est omis, il est considéré comme égal à 1.
      'La fonction MATCH renvoie la position de la valeur recherchée dans matrice_rechercher, et non la valeur proprement dite. Par exemple, la fonction MATCH("b",{"a","b","c"},0) renvoie 2, la position relative de « b » dans la matrice {"a","b","c"}.
      'La fonction MATCH ne distingue pas les majuscules et les minuscules lors de la recherche des valeurs de texte.
      'Si la fonction MATCH ne parvient pas à trouver une valeur correspondante, elle renvoie la valeur d'erreur #N/A.
      'Si type prend la valeur 0, vous pouvez utiliser des caractères génériques, des points d'interrogation (?) et des astérisques (*), dans lookup_value. Un point d'interrogation correspond à un caractère unique, un astérisque à une séquence de caractères. Si vous souhaitez rechercher un point d'interrogation ou un astérisque, entrez un tilde (~) avant le caractère.
      nocoul = (Application.Match(C.Value, OBJECT_DICTIONARY.keys, 0)) Mod UBound(couleurs) 'Définit la clé couleur à appliquer pour la cellule doublon
      C.Interior.ColorIndex = couleurs(nocoul) 'Color la cellule dans excel
      Compteur_Doublon2col = Compteur_Doublon2col + 1 'Compeur doublon colonne 2 prend +1
      '5.2.2 Définition d'un tableau de base zéro à une dimension contenant le nombre spécifié de sous-chaînes de la plage 1, prenant en col1 le numéro de ligne en cours de traitement dans plage1 et en col2 "-" pour colorisation équivalent plage2 dans la plage1 pour raccord
      A = Split(OBJECT_DICTIONARY.Item(C.Value), "-")
      For K = LBound(A) To UBound(A) - 1
         tmp = A(K) - PLAGE1.Row + 1 'variable tmp, prend valeur en cours dans plage1 excel
         PLAGE1(tmp).Interior.ColorIndex = couleurs(nocoul) 'Color ligne plage1 pour raccord avec plage2 de la meme couleur
      Next K
   End If
Next C
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'5.E Process de gestion d'erreur Error_comparaison
Error_comparaison:
If Err Then
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox ">Erreur<" & Chr(10) & " Comparaison arrêté suite à erreur. " & Chr(10) & Err.Number & " " & Err.Description, vbCritical, "RAPPROCHEMENT : COMPARAISON DOUBLON COLONNES"
Exit Sub
End If
'----------------------------------------------------------------------------------------------------------------------------------------------

'----------------------------------------------------------------------------------------------------------------------------------------------
'6. Activation du raffraichissement pour accélération de la vitesse
Application.ScreenUpdating = True
Application.EnableEvents = True
'----------------------------------------------------------------------------------------------------------------------------------------------

'----------------------------------------------------------------------------------------------------------------------------------------------
'7. Message d'indication de fin de traitement et rapport du nb de doublon trouvés suite à comparaison
MsgBox "Recherche terminé, " & Compteur_Doublon2col & " Doublon(s) trouvé(s).", vbInformation, "RAPPROCHEMENT : COMPARAISON DOUBLON COLONNES"
'----------------------------------------------------------------------------------------------------------------------------------------------

Merci à vous 2 !

Je vais explorer ton code Waard et essayer de l'adapter à mon fichier

Et tu as tout à fait raison Patrick1957, je le fais d'habitude mais je n'avais malheureusement pas le fichier sous la main

Je reviens vers vous pour vous tenir informer probablement dans la semaine, merci encore !

Nico.

Bonjour le forum,

Après adaptation, ton code fonctionne à merveille Waard, et il est très complet, c'est parfait !

Merci infiniment pour le partage !!

Bonne journée à vous

Nico.

Bonjour,

merci pour le retour et bravo à 'Waard' pour le code très bien documenté, c'est assez (très) rare pour le signaler

Patrick

Bonjour Patrick1957,

Tout à fait d'accord avec toi !

Bonne journée

Nico.

Hello, 8)

De rien et bon week-end tout le monde.

Rechercher des sujets similaires à "recherche doublons colonnes differentes vba"