Sub cmptdoublon()
Dim Plage As Range
Dim Tableau(), Resultat() As String
Dim i As Long, j As Long, m As Integer, j1 As Long
Dim Un As Collection
Dim trouve As Boolean
Dim Doublons As String
Set Un = New Collection
'colonne à tester
Set Plage = Range("A1:A" & Range("A65536").End(xlUp).Row)
ReDim Resultat(1 To Plage.Count, 1 To Plage.Count)
Tableau = Plage.Value
On Error GoTo suite
'boucle sur la plage à tester
For i = 1 To Plage.Count
If Tableau(i, 1) <> "" Then
Un.Add Tableau(i, 1), CStr(Tableau(i, 1))
End If
Next i
Set Un = Nothing
For j = LBound(Resultat) To UBound(Resultat)
If Resultat(j, 1) = "" Then
j1 = j
Exit For
End If
Call MsgBox("Valeur :" & Resultat(j, 1) _
& vbCrLf & "" _
& vbCrLf & "Nombre trouvé : " & Resultat(j, 2) _
, vbExclamation, "Doublons")
Next j
Exit Sub
suite:
trouve = False
For j = LBound(Resultat) To UBound(Resultat)
If Resultat(j, 1) = Tableau(i, 1) Then
Resultat(j, 2) = CLng(Resultat(j, 2)) + 1
trouve = True
Exit For
End If
If Resultat(j, 1) = "" Then
j1 = j
Exit For
End If
Next j
If trouve = False Then
Resultat(j1, 1) = Tableau(i, 1)
Resultat(j1, 2) = 0
End If
Resume Next
End Sub