Anzahl von Einträgen in einer Spalte ermitteln

Option Explicit

Sub Anzahl()

Application.ScreenUpdating = False

'
' Ermittelt, wie viele unterschiedliche Einträgevorhanden sind
' Grundlage der Prüfung = Index
'
    Dim objDictionary As Object
    Dim Bereich As Variant
    Dim lngZaehler As Long
    Dim arrDaten As Variant

    Set objDictionary = CreateObject("Scripting.Dictionary")
    With Worksheets("Tabelle1")
    '
    ' Der Bereich wie dynamischermittelt.
    ' Dadurch wird sichergestellt, dass auch bei leeren Zellen der gesamte Bereich ausgewertet wird.
    '
        Bereich = .Range("A3", .Range("A3").End(xlDown))
        
    End With
    ' Schleife über alle Werte
    For lngZaehler = LBound(Bereich) To UBound(Bereich)
        ' Eintrag wird nur übernommen wenn er im DictionaryObject noch nicht enthalten ist
        objDictionary(Bereich(lngZaehler, 1)) = 0
    Next
    'MsgBox "Es sind " & objDictionary.Count & " unterschiedliche einträge vorhanden." _
    '        , vbInformation, "Anzahl Index"
    
    Worksheets("Tabelle1").Range("C2").Value = "Anzahl"
    Worksheets("Tabelle1").Range("C3").Value = objDictionary.Count
    
End Sub