Bonjour à tous,

Je me tourne vers vous pour un besoin urgent et vous remercie d'avance de l'aide que vous m'apporterez.

Il y a quelques semaines, j'ai récupéré un code pour supprimer les doublons d'une feuille Excel. Je l'ai un peu retouché pour qu'il couvre mes besoins.

Aujourd'hui, j'aurai besoin de le faire évoluer. En effet, la version actuelle de l'outil se contente de me recréer une feuille (portant le nom choisi par l'utilisateur et entré dans la UserForm) qui contient les données de la feuille initiale, moins les lignes qui faisaient doublon.

Or, j'aimerai que les lignes, qui à l'origine possédaient un doublon, soient affichées dans une couleur quelconque, ou qu'un message (par exemple "Ex Doublon") apparaisse en face de chacune d'entre elles, afin que je puisse facilement les identifier par rapport aux lignes "saines" depuis le départ.

Comprenez-vous bien mon besoin ?

Voici la partie de mon code actuel ou il faudrait faire les modifs je pense:


Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
Private Sub CommandButton1_Click()
'Déclaration des variables (Inputs TextBox)
    Feuille_in = TextBox1.Text
    Feuille_out = TextBox2.Text
    Count = 0
    Reste = 0
    Res = 0
    chemin = TextBox12.Text
    nb = 1
'Vérification des conditions
    If Feuille_in <> nomfeuille Then
        MsgBox ("Le nom de la feuille à trier doit correspondre au nom de la feuille active (" & nomfeuille & ")")
    End If
 
    If Feuille_out = "" Then
        MsgBox ("Indiquez le nom de la feuille à remplir")
    End If
 
    If TextBox10 = "" Then
    MsgBox ("Indiquez le nom du fichier log doublons")
    End If
 
    If TextBox12 = "" Then
    MsgBox ("Indiquez un répértoire de destination")
    End If
 
If Feuille_in = nomfeuille And Feuille_in <> "" And Feuille_out <> "" And TextBox10.Text <> "" And TextBox12.Text <> "" Then
'Construction d'un dico (tableau) contenant les valeurs de chaque cellule
  Application.ScreenUpdating = False
  Set f1 = Sheets(Feuille_in)
  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)
        Count = Count + 1
        temp = ""
    For k = 1 To UBound(A, 2): temp = temp & A(i, k): Next
    If Not mondico.exists(temp) Then
      Reste = Reste + 1
      mondico.Add temp, 1
      For k = 1 To UBound(A, 2): c(ligne, k) = A(i, k): Next k
      ligne = ligne + 1
 
      Else
 
'Création d'un fichier contenant les doublons
 
 
    ChDir chemin
 
    H = FreeFile
 
    Open chemin & "\" & TextBox10.Text & "_" & Format(Now, "yyyymmdd") & ".csv" For Append As #H
 
          Print #H, ("Doublon " & nb)
 
 
            Print #H, (temp)
 
            temp = ""
 
            nb = nb + 1
 
    Close #H
 
    End If
  Next
 'Création nouvelle feuille ou recherche d'une feuille existante
    Fe = Feuille_out
        If WsExist(Fe) Then
            Worksheets(Fe).Activate
        Else
            Worksheets.Add
            ActiveSheet.Name = Fe
        End If
 'La macro remplit la feuille de destination
  Sheets(Fe).[A1].Resize(mondico.Count, UBound(A, 2)) = c
  Res = Count - Reste
  MsgBox (Count & " lignes ont été analysées par l'outil. " & Res & " doublons ont été détectés et " & Reste & " codes uniques ont été importés dans la feuille " & "'" & Fe & "'. Cliquez sur 'Exit' pour afficher le résultat.")
  MsgBox ("Fichier log doublons " & TextBox10.Text & "_" & Format(Now, "yyyymmdd") & ".csv généré avec succés dans le répértoire " & chemin)
End If
End Sub
Pourriez vous, SVP, le retoucher en faisant en sorte que les Ex Doublons apparaissent soit en couleur, soit qu'ils soient associés à un message "Ex Doublon" SVP ?


Merci