Excel / VBA / MS查询创建范围的每个可能组合

Question

我遇到了一个无法找到解决方案的问题。

我有一张5的电子表格 - > 10？数据列。它们都不同，但有些列彼此相关（如果A3 = 1，则B3 = A，C3 = a）。每列包含3 - > 6个参数的变化，我需要创建它们的所有可能的组合..

列中的初始数据：

预期结果：

Kelvin之前差不多相似problem，但这对我不起作用..

Answer 1

您可以使用带交叉连接的SQL来实现。下面是我制作和测试的一个小例子。您必须根据自己的需要进行调整。在我的示例中，test1和test3是sheet1的第一行中的列名。

Sub SQLCombineExample()
    Dim con
    Dim rs
    Set con = CreateObject("ADODB.Connection")
    con.Open "Driver={Microsoft Excel Driver (*.xls)};" & _
           "DriverId=790;" & _
           "Dbq=" & ThisWorkbook.FullName & ";" & _
           "DefaultDir=" & ThisWorkbook.FullName & ";ReadOnly=False;"
    Set rs = CreateObject("ADODB.Recordset")
    Set rs = con.Execute("select distinct a.[test1], b.[test3] from [Sheet1$] as a , [Sheet1$] as b ")
    Range("f1").CopyFromRecordset rs
    Set rs = Nothing
    Set con = Nothing
End Sub

Answer 2

从我在图片中看到的内容，唯一可以更改组合的项目是第4列中的项目： （1; A; a; item4;#¤），（2; B; b; item4;＆amp;#¤）和（3; C; c; item4;¤％＆amp;）

如果这确实是您尝试做的事情，则以下代码应该有效：

Sub Combination()

Dim i As Integer, j As Integer, k As Integer

    For k = 0 To 2 'loop through (1 A a #¤), (2 B b &#¤) and (3 C c ¤%&)

        j = 3 'column 4 items

        For i = 0 To 6 Step (3) 'loop 3 by 3 (output starts in row 10)

                Cells(10 + k + i, 1) = Cells(3 + k, 1)
                Cells(10 + k + i, 2) = Cells(3 + k, 2)
                Cells(10 + k + i, 3) = Cells(3 + k, 3)
                Cells(10 + k + i, 5) = Cells(3 + k, 5)

                Cells(10 + k + i, 4) = Cells(j, 4)

        j = j + 1

        Next i

    Next k

End Sub

Answer 3

Sub CopyAllCombinationsToRange()

    Dim arSource
    Dim arResult

    Dim i As Long, j As Long, combinationCount As Long, counter As Long

    arSource = Range(Cells(2, 1), Cells(Rows.Count, 5).End(xlUp)).Value

    combinationCount = UBound(arSource, 2) * UBound(arSource, 2)
    ReDim arResult(4, combinationCount - 1)

    For i = 1 To UBound(arSource, 1)
        For j = 1 To UBound(arSource, 1)

            arResult(0, counter) = arSource(i, 1)
            arResult(1, counter) = arSource(i, 2)
            arResult(2, counter) = arSource(i, 3)
            arResult(3, counter) = arSource(i, 4)
            arResult(4, counter) = arSource(j, 5)
            counter = counter + 1
        Next
    Next

    Sheet2.Range("A1").Resize(UBound(arResult, 2), 5) = WorksheetFunction.Transpose(arResult)

End Sub

示例