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

【问题标题】：Excel/VBA/MS Query to create every possible combination of a RangeExcel/VBA/MS 查询以创建范围的每个可能组合
【发布时间】：2016-06-29 11:35:35
【问题描述】：

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

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

列中的初始数据：

预期结果：

Kelvin 之前有几乎相似的problem，但这对我不起作用..

【问题讨论】：

您将首先图表暗示它们是 5 个表，并且在您的描述中您说有“5 -> 10 列？”。他们是 5 个不同的表，具有不同的列数，并且每个表中有一个 Key Column，还是有一个具有多个 Key Columns 的表？
嗨。有 1 个表格/电子表格，其中包含多列。我换个图。
有多少列，哪些是关键列，哪些是保存值。您的图片显示 5 列，键、键、键、值、值。是这样吗？
现在就对了。如果我只是明白你的代码/提示的意思，我可以稍后修改它。

标签： database vba excel

【解决方案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

【讨论】：

您没有提到要引用哪个库。我尝试了最新的 ActiveX Dataobjects 库并得到了错误。参数太少。
@ThomasInzina：对：我使用的是 Microsoft ActiveX Data Objects 6.1 Library。
好的，我知道了。很棒的答案，但您忽略了所有细节。您应该解释 test1 和 test3 引用列名并将查询更改为 select distinct a.* , b.test3 from [Sheet1$] as a , [Sheet1$] as b.
该死，你甚至不必保存工作簿。那很紧我正在将它添加到我的武器库中！
@ThomasInzina：通过这个技巧，您甚至可以加入不同的工作表并进行更新查询 8-)

【解决方案2】：

根据我在您的图片中看到的，唯一可以更改组合的项目是第 4 列中的项目： (1 ; A ; a ; item4 ; #¤), (2 ; B ; b ; item4 ; ¤) 和 (3 ; C ; c ; item4 ; ¤%&)

如果这确实是您正在尝试执行的操作，则以下代码应该可以工作：

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

【讨论】：

【解决方案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

示例

【讨论】：