VBA- Macro comparative

Option Explicit

Sub ProcedurePrincipale()
'Déclaration des variables
Dim MonDico As Object
Dim TablA, TablBC, TablID, Cpt As Long
Dim Message As String, Msg As String, Repons As Integer

'initialisation du message de fin pour l'utilisateur
    'en cas de données contenues dans A mais pas dans C
    'qui n'auraient donc pas d'ID... Juste au cas ou...
Message = "Ces données ont été trouvées colonne A mais pas colonne C :"

'I-- remplissage des variables tableaux "d'entrée" :
    '1- TablA (colonne A)
    '2- TablBC (colonnes B & C)
    '3- TablID (les ID correspondants aux éléments de la colonne A)
    
'1    '- TablA = données contenues colonne A
TablA = Range("A2", Range("A" & Rows.Count).End(xlUp))
    '***************************************************************
    ' On propose à l'utilisateur de supprimer les doublons colonne A
    Repons = MsgBox("Voulez vous supprimer les doublons colonne A?", vbYesNo + vbCritical, "!!! Suppression définitive !!!")
    '-- Si l'utilisateur veux supprimer les doublons alors
    If Repons = vbYes Then
        'on lance la fonction appropriée (cf code ci-dessous)
        '-- APPEL DE LA FONCTION avec en paramètre notre TablA :
        SupprimeDoublonsColonneA TablA
        'on efface la variable tableau TablA qui contient les anciennes données colA
        Erase TablA
        'on le remplit à nouveau des nouvelles données contenues colonne A
        TablA = Range("A2", Range("A" & Rows.Count).End(xlUp))
    End If
    '***************************************************************
'2    '- TablBC = données contenues colonnes B & C
TablBC = Range("B2", Range("C" & Rows.Count).End(xlUp))

'3    '- TablID = futurs ID correspondants aux articles colonne A
        'TablID ne sera remplit qu'après le dictionnaire,
        'pour l'instant on le dimensionne à la bonne taille
ReDim TablID(UBound(TablA))

'II-- L'objet Dictionary
        'va servir à stocker les ID et les Noms
        'en faisant en sorte qu'ils se correspondent.
        'En effet, un élément de dictionary est construit comme ceci :
        'Dico clé,élément
        'pour en savoir plus :
        'http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm

'1- création de l'objet dictionary
Set MonDico = CreateObject("Scripting.Dictionary")
'le fait de boucler sur une variable tableau est + rapide
'que de boucler sur les cellules de la feuille
For Cpt = LBound(TablBC, 1) To UBound(TablBC, 1)

'2- remplissage du Dictionary :
    '- clés = n° ID (colonne B = TablBC(Cpt, 1))
    '- éléments = Noms (colonne C = TablBC(Cpt, 2))
    If Not MonDico.Exists(TablBC(Cpt, 2)) Then MonDico.Add TablBC(Cpt, 2), TablBC(Cpt, 1)
Next Cpt

'III-- Remplissage de la variable tableau TablID
    'TablID va contenir les ID correspondants aux éléments de notre TablA (colonne A)
For Cpt = LBound(TablA, 1) To UBound(TablA, 1)
    'Si l'élément TablA n'existe pas dans MonDico,
    'ça signifie que l'élément colonne A n'existe pas colonne C.
    If Not MonDico.Exists(TablA(Cpt, 1)) Then
        'Alors, on remplit le message à l'utilisateur avec :
            'Le contenu de cet élément : TablA(Cpt, 1)
            'la ligne ou il se trouve colonne A : Cpt + 1
        Message = Message & Chr(10) & "- " & TablA(Cpt, 1) & ", Ligne : " & Cpt + 1
    'Sinon, s'il existe bien colonne C
    Else
        'on remplit la variable tableau TablID des n° d'ID correspondants
        TablID(Cpt - 1) = MonDico(TablA(Cpt, 1))
    End If
Next

'IV-- Restitution des données
    'ici deux choix sont proposés à l'utilisateur :
        'Choix 1:
            'Colonne A : noms des articles déclassés
            'Colonne B : ID des articles classés
            'Colonne C : Noms des articles classés
            'Colonne D : ID des articles déclassés
        'Choix 2:
            'Colonne A : noms des articles déclassés
            'Colonne B : ID des articles déclassés
            'Colonne C : Noms des articles classés
            'Colonne D : ID des articles classés
'1- Choix 1 :
Msg = "Souhaitez vous obtenir :" & Chr(10) & _
            "- Colonne A : noms des articles déclassés" & Chr(10) & _
            "- Colonne B : ID des articles classés" & Chr(10) & _
            "- Colonne C : Noms des articles classés" & Chr(10) & _
            "- Colonne D : ID des articles déclassés"
Repons = MsgBox(Msg, vbYesNo + vbCritical, "Restitution des données")
If Repons = vbYes Then
    Range("D2").Resize(UBound(TablID), 1) = Application.Transpose(TablID)
    If Message <> "Ces données ont été trouvées colonne A mais pas colonne C :" Then MsgBox Message
    Exit Sub
End If

'2- Choix 2 :
Msg = "Souhaitez vous obtenir :" & Chr(10) & _
            "- Colonne A : noms des articles déclassés" & Chr(10) & _
            "- Colonne B : ID des articles déclassés" & Chr(10) & _
            "- Colonne C : Noms des articles classés" & Chr(10) & _
            "- Colonne D : ID des articles classés"
Repons = MsgBox(Msg, vbYesNo + vbCritical, "Restitution des données")
If Repons = vbYes Then
    '!!!!!! ICI SUPPRESSION DES DONNEES !!!!!!!!
        '==> d'où l'intérêt de travailler sur une copie du classeur
    Range("B2", Range("C" & Rows.Count).End(xlUp)).ClearContents
    Range("B2").Resize(UBound(TablID), 1) = Application.Transpose(TablID)
    Range("C2").Resize(MonDico.Count) = Application.Transpose(MonDico.keys)
    Range("D2").Resize(MonDico.Count) = Application.Transpose(MonDico.items)
    If Message <> "Ces données ont été trouvées colonne A mais pas colonne C :" Then MsgBox Message
End If
End Sub

'Fonction de suppression des doublons colonne A
    'cette fonction a pour paramètre une variable tableau
    'cette variable tableau contient les données de la colonne A selon l'appel
    'de cette fonction dans la procédure principale : SupprimeDoublonsColonneA TablA
Function SupprimeDoublonsColonneA(Tableau As Variant)
Dim DicoA As Object, i As Long

'création du dictionnaire
Set DicoA = CreateObject("Scripting.Dictionary")
For i = LBound(Tableau, 1) To UBound(Tableau, 1)
    'si le contenu de notre tableau n'existe pas dans le dictionnaire alors on l'ajoute
    If Not DicoA.Exists(Tableau(i, 1)) Then DicoA.Add Tableau(i, 1), Tableau(i, 1)
    's'il existe déjà, il n'est pas ajouté...
Next i
'Supprime les données de la colonne A
Range("A2", Range("A" & Rows.Count).End(xlUp)).ClearContents
'les remplace par les mêmes, sans les doublons, soit par les éléments de notre DicoA...
Range("A2").Resize(DicoA.Count) = Application.Transpose(DicoA.keys)
End Function