如何接收所有列的所有组合？

Question

我正在尝试获取所有列的所有行组合（比如8列）。以下vba宏可以做到这一点，但我得到一个错误，说明数据过载：

Option Explicit

Const sTitle        As String = "shg Cartesian Product"

Sub CartesianProduct()

' shg 2012, 2013
' Choose one from col A, one from col B, ...

Dim rInp        As Range
Dim avInp       As Variant  ' ragged input list
Dim nCol        As Long     ' # columns in list
Dim rOut        As Range    ' output range
Dim iCol        As Long     ' column index
Dim iRow        As Long     ' row index
Dim aiCum()     As Long     ' cum count of arrangements from right to left
Dim aiCnt()     As Long     ' count of items in each column
Dim iArr        As Long     ' arrangement number
Dim avOut       As Variant  ' output buffer

Application.ScreenUpdating = False

Set rInp = Range("rgnInp")
If VarType(rInp.Value) = vbEmpty Then
    MsgBox Prompt:="No input!", _
           Buttons:=vbOKOnly, _
           Title:=sTitle
    Exit Sub
End If

Set rInp = rInp.CurrentRegion
If rInp.Columns.Count < 2 Or rInp.Rows.Count < 2 Then
    MsgBox Prompt:="Must have more than one row and more than one columns!", _
           Buttons:=vbOKOnly, _
           Title:=sTitle
    Exit Sub
End If

With rInp
    .Style = "Input"
    avInp = .Value
    nCol = .Columns.Count
    Set rOut = .Resize(1).Offset(.Rows.Count + 1)
    Range(rOut.Offset(-1, -1), Cells(Rows.Count, Columns.Count)).Clear
End With

ReDim aiCum(1 To nCol + 1)
ReDim aiCnt(1 To nCol)
aiCum(nCol + 1) = 1

For iCol = nCol To 1 Step -1
    For iRow = 1 To UBound(avInp, 1)
        If IsEmpty(avInp(iRow, iCol)) Then Exit For
        aiCnt(iCol) = aiCnt(iCol) + 1
    Next iRow

    aiCum(iCol) = aiCnt(iCol) * aiCum(iCol + 1)   <------ This is where it says error is
Next iCol

If aiCum(1) > Rows.Count - rOut.Row + 1 Then
    MsgBox Prompt:=Format(aiCum(1), "#,##0") & _
                   " is too many rows!", _
           Buttons:=vbOKOnly, Title:=sTitle
    Exit Sub
End If

ReDim avOut(1 To aiCum(1), 1 To nCol)
For iArr = 1 To aiCum(1)
    For iCol = 1 To nCol
        avOut(iArr, iCol) = avInp((Int((iArr - 1) * aiCnt(iCol) / aiCum(iCol))) Mod aiCnt(iCol) + 1, iCol)
    Next iCol
Next iArr

With rOut.Resize(aiCum(1), nCol)
    .NumberFormat = "@"
    .Value = avOut
    .Style = "Code"
    .Cells(1, 0).Value = 1
    .Cells(2, 0).Value = 2
    .Cells(1, 0).Resize(2).AutoFill .Columns(0)
End With

ActiveWindow.FreezePanes = False
rOut.EntireColumn.AutoFit
ActiveSheet.UsedRange
Beep
End Sub

有没有为此调整？我也希望它不会为一行带回相同的值。因此，假设两列具有完全相同的数据。如果A栏允许说冰淇淋，蛋糕和饼干，B栏也是如此，如果已经在A栏中选择了第1行，我不希望第1行在B栏中有饼干。