Repèrer les doubles

[isa44]

Bonsoir, je cherche un code pour repérer les doubles et mettre leur police en rouge et fond de cellules en noir.

petit fichier ci joint :


Merci pour votre aide

 

[Victor21]

Re : Repèrer les doubles

Bonsoir, isa44

Essauez avec la mise en forme conditionnelle (pas besoin de code)
Sélectionnez la zone bus, puis format, mise en forme conditionnelle,
La formule est :

=NB.SI(bus;D2)>1

Et choisissez la couleur de fond et de police

 

[Fred0o]

Re : Repèrer les doubles

Bonjour Isa44,

Voici un code qui semble correspondre à ta demande :

Sub test()
    Dim i, j, dl, NRef
    dl = Range("D65536").End(xlUp).Row
    For j = 2 To dl - 1
        If Cells(j, 4) <> "" Then
            NRef = Cells(j, 4)
            For i = j + 1 To dl
                If NRef = Cells(i, 4) Then
                    Cells(j, 4).Interior.Color = vbBlack
                    Cells(j, 4).Font.Color = vbRed
                    Cells(i, 4).Interior.Color = vbBlack
                    Cells(i, 4).Font.Color = vbRed
                End If
            Next
        End If
    Next
End Sub

A+

 

[isa44]

Re : Repèrer les doubles

Merci Fredo , cela fonctionne parfaitement