Sachmerkmal Kombinationen nur bis Zeile 65536

Sub Kombi()
Dim arr_Data As Variant, arr_Desc As Variant
Dim arr_Result As Variant
Dim arrtemp As Variant
Dim i As Long, j As Long, k As Long, n As Long
Dim varCombinations As Variant
Dim lngR As Long, lngC As Long
lngC = Cells(2, Columns.Count).End(xlToLeft).Column
ReDim arr_Desc(1 To 2, 1 To lngC - 1)
For j = lngC To 2 Step -1
arr_Desc(1, j - 1) = Cells(Rows.Count, j).End(xlUp).Row - 2
If j  lngC Then
arr_Desc(2, j - 1) = arr_Desc(1, j - 1) * arr_Desc(2, j)
Else
arr_Desc(2, j - 1) = arr_Desc(1, j - 1)
End If
If arr_Desc(1, j - 1) > lngR Then
lngR = arr_Desc(1, j - 1)
End If
Next j
arr_Data = Range(Cells(3, 2), Cells(lngR + 2, lngC))
varCombinations = arr_Desc(2, 1)
If varCombinations > 65000 Then
MsgBox "Kombinationen: " & varCombinations & vbCrLf & vbCrLf _
& "Berechnung wird abgebrochen"
Exit Sub
End If
MsgBox "Kombinationen: " & varCombinations
ReDim arr_Result(1 To arr_Desc(2, UBound(arr_Desc, 2)))
For i = 1 To UBound(arr_Result)
arr_Result(i) = arr_Data(i, UBound(arr_Data, 2))
Next i
For i = UBound(arr_Desc, 2) - 1 To 1 Step -1
ReDim arrtemp(1 To arr_Desc(2, i))
For j = 1 To arr_Desc(1, i)
For k = 1 To UBound(arr_Result)
n = n + 1
arrtemp(n) = arr_Data(j, i) & "-" & arr_Result(k)
Next k
Next j
arr_Result = arrtemp
n = 0
Next i
With Sheets(2)
.Cells.Clear
.Cells(2, 7).Resize(UBound(arr_Result), 1) = _
WorksheetFunction.Transpose(arr_Result)
End With
End Sub