VBArecursion“For循环”排列？
以下是我的代码。 我想通过recursion方法达到相同的结果，因为嵌套循环的数量从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 
我也在互联网上find一个recursion的代码示例，但我真的不知道如何根据我的需要进行修改。 任何帮助将是非常好的。
recursion代码示例
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
问候
如果您仍然希望修复代码来产生所需的结果。
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
对于未来的读者，OP的需求基本上遵循笛卡尔乘积 （ Cartesian Product） ，即集合之间所有有序对的math运算。 可以很容易地运行交叉连接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;
devise
产量
Excel解决scheme
因为VBA可以通过包括Excel的ODBC Jet Driver在内的关联驱动程序连接到各种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
我把它作为一个二元问题来处理：
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