Option Explicit
Private m_lngCount As Long
Function ZählenBisWechsel(ByRef rng As Excel.Range) As Variant
Dim arr, ret
Dim i As Long, ii As Long
Count2Array = rng.Columns.Count
arr = Application.Index(Application.Transpose(rng), Count2Array, 0)
ii = 1
For i = LBound(arr) To UBound(arr)
If Not i = UBound(arr) Then
If Not i = 1 Then
If arr(i) = arr(i + 1) Then
ii = ii + 1
Else
ret = ret & ii & "x" & arr(i) & ","
ii = 1
End If
Else
ret = ret & ii & "x" & arr(i) & ","
End If
Else
If arr(i) = arr(i - 1) Then
ret = ret & ii & "x" & arr(i) & ","
Else
ii = 1
ret = ret & ii & "x" & arr(i) & ","
End If
End If
Next i
ZählenBisWechsel = Left(ret, Len(ret) - 1)
End Function
Private Property Get Count2Array() As Variant
Dim x() As Long, i As Long
ReDim x(1 To m_lngCount)
For i = 1 To m_lngCount
x(i) = i
Next i
Count2Array = x()
End Property
Private Property Let Count2Array(ByVal flngCount As Variant)
m_lngCount = flngCount
End Property