VBA 递归 "For loops" 排列？

Question

下面是我的代码。我想通过递归方法获得相同的结果，因为嵌套循环的数量从 2 到最大 8 不等。

Sub permutation()

c1 = Array(1, 2)
c2 = Array(3, 4)
c3 = Array(5, 6)
c4 = Array(7, 8)
c5 = Array(9, 10)
c6 = Array(11, 12)
c7 = Array(13, 14)
c8 = Array(15, 16)

With Sheets("Criteria")
    .Cells.Clear
    n = 1
    For a = LBound(c1) To UBound(c1)
        For b = LBound(c2) To UBound(c2)
            For c = LBound(c3) To UBound(c3)
                For d = LBound(c4) To UBound(c4)
                    For e = LBound(c5) To UBound(c5)
                         For f = LBound(c6) To UBound(c6)
                             For g = LBound(c7) To UBound(c7)
                                 For h = LBound(c8) To UBound(c8)

                                Cells(n, 1).Value = c1(a)
                                Cells(n, 2).Value = c2(b)
                                Cells(n, 3).Value = c3(c)
                                Cells(n, 4).Value = c4(d)
                                Cells(n, 5).Value = c5(e)
                                Cells(n, 6).Value = c6(f)
                                Cells(n, 7).Value = c7(g)
                                Cells(n, 8).Value = c8(h)
                                n = n + 1

                                Next h
                            Next g
                        Next f
                    Next e
                Next d
            Next c
        Next b
    Next a
End With
End Sub

我也在网上找到了一个递归代码示例，但是我真的不知道如何根据我的需要修改。任何帮助都会很棒。

递归代码示例

Sub RecurseMe(a, v, depth)
    If a > depth Then
        PrintV v
        Exit Sub
    End If
    For x = 1 To 4
        v(a) = x
        a = a + 1
        RecurseMe a, v, depth
        a = a - 1
    Next x
End Sub

Sub PrintV(v)
    For J = 1 To UBound(v): Debug.Print v(J) & " ";: Next J
    Debug.Print
End Sub
Sub test()
    Dim v()
    depth = 4 'adjust
    a = 1
    ReDim v(1 To depth)
    RecurseMe a, v, depth
End Sub

此致

Answer 1

如果您仍希望修复代码以产生所需的结果。

Sub RecurseMe(a, v, depth, rw)

    If a > depth Then
        rw = rw + 1
        PrintV v, rw
        Exit Sub
    End If
    For x = 1 To 2
        v(a) = x + ((a - 1) * 2)
        a = a + 1
        RecurseMe a, v, depth, rw
        a = a - 1
    Next x
End Sub

Sub PrintV(v, rw)
    For j = 1 To UBound(v)
        ActiveSheet.Cells(rw, j) = v(j) ' & " ";
    Next j
End Sub
Sub test()
    Dim v()
    Dim rw As Long
    rw = 0
    depth = 8 'adjust to adjust the number of columns
    a = 1
    ReDim v(1 To depth)
    RecurseMe a, v, depth, rw
End Sub

Answer 2

我将其作为二元问题来处理：

Public Sub Perms(lCyles As Long)

    Dim sBin As String
    Dim i As Long
    Dim j As Long
    Dim n As Long

    With Sheets("Criteria")
        .Cells.Clear
        n = 1
        For i = 0 To 2 ^ lCyles - 1
            sBin = WorksheetFunction.Dec2Bin(i)
            sBin = String(lCyles - Len(sBin), "0") & sBin
            For j = 1 To Len(sBin)
                .Cells(n, j) = IIf(Mid(sBin, j, 1) = "1", j * 2, j * 2 - 1)
            Next j
            n = n + 1
        Next i
    End With

End Sub

Answer 3

对于未来的读者，OP 的需求本质上是遵循一个 Cartesian Product, a mathematical operation of all ordered pairs between sets. One can easily run the Cross Join SQL 查询，或者特别是一个没有任何 JOIN 语句的查询来实现结果集。这也称为完整外部联接查询。

一些 SQL 引擎，如 SQL Server 使用 CROSS JOIN 语句，其结果集等于每个包含的查询 table 的产品行（例如，2*2*2*2*2*2*2*2 = 2^8 = 256).

在MS Access（MS Excel的同级数据库）中，使用table定义为两个项目的8个数组，下面是交叉连接查询。每个数组 table 中的项目字段带有配对 (1,2), (3,4), (5,6) ...

SELECT Array1.Item, Array2.Item, Array3.Item, Array4.Item, 
       Array5.Item, Array6.Item, Array7.Item, Array8.Item
FROM Array1, Array2, Array3, Array4, 
     Array5, Array6, Array7, Array8;

设计

输出

Excel解法

因为 VBA 可以通过相关驱动程序连接到各种 SQL 引擎，包括 Excel 的 ODBC Jet 驱动程序，工作簿可以连接到工作表范围和运行相同的交叉连接查询：

Sub CrossJoinQuery()

    Dim conn As Object
    Dim rst As Object
    Dim sConn As String, strSQL As String

    Set conn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")

    sConn = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
               & "DBQ=C:\Path To\Excel\Workbook.xlsx;"
    conn.Open sConn

    strSQL = "SELECT * FROM [ArraySheet1$A1:A3], [ArraySheet2$A1:A3], 
                            [ArraySheet3$A1:A3], [ArraySheet4$A1:A3],
                            [ArraySheet5$A1:A3], [ArraySheet6$A1:A3], 
                            [ArraySheet7$A1:A3], [ArraySheet8$A1:A3]"
    rst.Open strSQL, conn

    Range("A1").CopyFromRecordset rst

    rst.Close
    conn.Close

    Set rst = Nothing
    Set conn = Nothing

End Sub

VBA 递归 "For loops" 排列？

VBA recursive "For loops" Permutation?

excel

recursion

vba

for-loop

permutation