Surligner doublons sur plusieurs feuilles avec VBA

Bonjour,

Je suis novice dans EXCEL et VBA.

Mon fils a eu besoin de surligner les doublons sur plusieurs feuilles Excel. Je lui ai trouvé la solution sur des forums, solution avec la mise en forme conditionnelle ce qui fonctionne bien.

Par curiosité perso j'essaie depuis une semaine de faire la même chose en VBA, en vain.

Dans le fichier joint j'ai donc deux feuilles avec des noms sur une colonne (le plus simple possible).

je voudrais colorer d'une couleur les cases ou se trouvent des doublons .

Je verrai plus tard pour éventuellement supprimer les doublons pour ne laisser qu'une valeur….

Merci la communauté

Salut 57608386,

par exemple, sans fioriture aucune...

Code à coller dans le module VBA de 'Feuil1'.

Un changement en 'Feuil1' démarre la macro.

Private Sub Worksheet_Change(ByVal Target As Range)
'
For x = 1 To Range("A" & Rows.Count).End(xlUp).Row
    For y = 2 To Sheets.Count
        With Sheets(y)
            For Z = 1 To .Range("A" & Rows.Count).End(xlUp).Row
                If UCase(Range("A" & x).Value) = UCase(.Range("A" & Z).Value) Then _
                    Range("A" & x).Interior.ColorIndex = 4: _
                    .Range("A" & Z).Interior.ColorIndex = 4
            Next
        End With
    Next
Next
'
End Sub

A+

Bonjour,

La procédure suivante, va indiquer les doublons, en vert, dès le 1er doublon. ("l'originel" ne sera pas indiqué)!

Option Explicit

Sub Indique_Doublons()
Dim Ws As Worksheet, d As New Collection, Rng As Range, C As Range, Dl As Long
    For Each Ws In ThisWorkbook.Worksheets
        With Ws
            Dl = drlig(.Columns(1))
            Set Rng = .Range("A1:A" & Dl) 'A1 = 1ère cellule à traiter / A = Colonne A..........
            For Each C In Rng
                On Error Resume Next
                d.Add CStr(C.Value2), CStr(C.Value2)
                If Err.Number > 0 Then
                    C.Interior.ColorIndex = 4 'Ici, changer la valeur numérique changera la couleur (3 = rouge...)
                    On Error GoTo 0
                End If
            Next
        End With
    Next
End Sub
Function drlig(plage As Range) As Long
    If WorksheetFunction.CountA(plage) = 0 Then drlig = plage.Cells(1, 1).Row: Exit Function
    drlig = plage.Find("*", , , , , xlPrevious).Row
End Function

merci à curulis57 et pijaku, pour leurs réponses rapides

voilà de quoi m'occuper, je vais essayer de comprendre vos procédures. C'est loin de ce que j'avais essayé jusqu'ici

j'en suis encore à ingurgiter programmation VBA pour les nuls, je vois que le chemin sera long.

merci

svp pijaku

pourrais tu me commenter ta démarche à partir de

d.Add CStr(C.Value2), CStr(C.Value2)

a la fin

merci

curulis57

ta macro est plus courte et plus simple à comprendre, j'y suis arrivé.

elle fonctionne parfaitement.

par contre j'ai dû enlever "ByVal Target As Range" et private pour la mettre dans un module.

puis déclarer x,y,z

merci