Typenunverträglichkeit

Sub Namen_Zaehlen()
Dim vVal As Variant, vRes() As Variant
Dim rng As Range
Dim lngI As Long
Dim strMsg As String
Set rng = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
vVal = rng
Redim vRes(0)
vRes(0) = "###"
For lngI = 1 To UBound(vVal, 1)
If Not IsNumeric(Application.Match(vVal(lngI, 1), vRes, 0)) Then
strMsg = strMsg & vVal(lngI, 1) & vbTab & vbTab & Application.CountIf(rng, vVal(lngI, 1)) & vbLf
Redim Preserve vRes(UBound(vRes) + 1)
vRes(UBound(vRes)) = vVal(lngI, 1)
End If
Next
If Len(strMsg) > 0 Then MsgBox strMsg
End Sub