Option Explicit
Sub ZähleBegriffe()
Dim Arng As Range, Zrng As Range
Dim Aarr() As Variant, V As Variant
Dim y As Long
Set Arng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
Aarr = GetDistinct(Arng)
Set Zrng = Range("D1").Resize(1, UBound(Aarr) + 1)
With Zrng
.Value = Aarr
For Each V In Aarr
y = y + 1
With Zrng.Cells(y).Offset(1)
.Value = WorksheetFunction.SumIf(Arng, V, Arng.Offset(, 1))
End With
Next V
End With
End Sub
Private Function GetDistinct(ByVal oTarget As Range) As Variant
Dim varArray As Variant
Dim objMyDic As Object
Dim V As Variant
Set objMyDic = CreateObject("Scripting.Dictionary")
varArray = oTarget
For Each V In varArray
objMyDic(V) = V
Next
GetDistinct = objMyDic.Items()
End Function