VBA遞歸「For循環」排列？

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，臺之間的所有有序對的數學運算。人們可以很容易地運行Cross Join SQL查詢或者特別是沒有任何JOIN語句的查詢來實現結果集。這也被稱爲完整外部聯接查詢。

某些SQL引擎（如SQL Server）使用CROSS JOIN語句，其結果集等於每個包含的查詢表的產品行（例如，2*2*2*2*2*2*2*2 = 2^8 = 256）。

在MS Access（MS Excel中的數據庫同級）中，使用定義爲兩個項目的8個數組的表格，下面是交叉連接查詢。在每個陣列表項字段攜帶所述配對(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可以連接到由相關的驅動程序，包括Excel的ODBC噴氣驅動各種SQL引擎，一個工作簿可以連接到工作表的範圍和運行相同的交叉連接查詢：

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