HiiiCoach
Messages postés27Date d'inscriptionvendredi 30 avril 2010StatutMembreDernière intervention 1 juin 2011
-
1 juin 2011 à 11:56
HiiiCoach
Messages postés27Date d'inscriptionvendredi 30 avril 2010StatutMembreDernière intervention 1 juin 2011
-
1 juin 2011 à 14:32
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 ces lignes soient affichées dans une couleur quelconque, ou qu'un message (par exemple "Ex Doublon") apparaisse dans une cellule, afin que je puisse facilement identifier les lignes qui étaient doublonnées à la base.
Comprenez-vous bien mon besoin ?
Voici la partie de mon code actuel ou il faudrait faire les modifs je pense:
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 els Ex Doublons apparaissent soit en couleur, soit qu'ils soient associés à un message "Ex Doublon" SVP ?