Function Zusammenfassen(Bereich As Range, Optional Delimiter As String) As String
Dim s As String, n As Long
For i = 1 To Bereich.Cells.Count
n = n + 1
If Bereich.Cells(i) <> Bereich.Cells(i + 1) Or i = Bereich.Cells.Count Then
s = s & IIf(n > 1, n & "x", "") & Bereich.Cells(i) & Delimiter
n = 0
End If
Next i
Zusammenfassen = Left(s, Len(s) - Len(Delimiter))
End Function