doublons multiples

[Rem$]

bonjour à tous,

voici le code que j'utilise pour repérer mes doublons

Dim ref As String
Dim cell As Range, plage As Range
Dim L As Integer
On Error Resume Next
If Application.Intersect(Target, Range('b:b')) Is Nothing Then Exit Sub
ref = Target.Value
L = Target.Row
Set plage = Range('b1:b' & L - 1)
For Each cell In plage
If cell = ref Then
MsgBox '!! DOUBLONS !! le N° a déjà était saisie en ' & cell.Address, vbInformation, 'DOUBLONS'
cell.Activate
Exit Sub
End If
Next cell

mais comment faire s'il y a plusieurs fois le meme N° ???

d'avance merci
Rem$

 

[PascalXLD]

Bonjour

Essaies en modifiant légèrement le code


Dim ref As String, MonMessage as string
Dim cell As Range, plage As Range
Dim L As Integer
On Error Resume Next
If Application.Intersect(Target, Range('b:b')) Is Nothing Then Exit Sub
ref = Target.Value
L = Target.Row
Set plage = Range('b1:b' & L - 1)
For Each cell In plage
If cell = ref Then

MonMessage= MonMessage & cell.address & ' '
cell.interior.colorindex=3 ' si tu veux colorier les doublons

End If
Next cell

MsgBox '!! DOUBLONS !! le N° a déjà était saisie en ' & MonMessage, vbInformation, 'DOUBLONS'


Bon courage