Excel vba 创建范围的所有可能组合

Posted 2023-03-31

【中文标题】Excel vba 创建范围的所有可能组合

【英文标题】：Excel vba to create every possible combination of a Range

【发布时间】：2012-05-28 09:22:18

【问题描述】：

我有一个问题，我无法在网络上的任何地方找到（它可能在那里，但我找不到，呵呵）。

我有一个包含 13 列数据的电子表格。每一列都包含需要进入整个测试用例的参数的变体。

它们都不同，比如

E: 101% 105% 110% 120%

J： 上S 上行L 缺点 B 高级版V

我已经看到了几种使用嵌套循环的组合问题的解决方案。我想避开 13 个嵌套循环（但这是我目前最好的选择）。我不知道如何在每列中生成每个独特的组合。

我不确定这对你们来说是否足够有意义。我希望有人至少可以用递归算法为我指明正确的方向。我想让它足够动态，以容纳不同数量的列和行。

感谢你们能给我的任何帮助。

【问题讨论】：

恐怕你将不得不使用循环。最好的办法是使用 13 个数组，每个数组保存特定的范围，然后生成组合。

我遇到的最佳方法是建立一个 ODBC 数据连接，将 Excel 文件指向自身，然后针对您的数据创建一个交叉连接（笛卡尔）查询。

好吧，“最好”可能不是一个好的词选择。另一种方法是设置一个迭代所有可能索引的工作表，然后使用INDEX 查找值。这实际上是一个 13 维数组，但仅使用工作表函数。

我喜欢交叉连接解决方​​案。我明天必须试一试。我什至没有想到。

如果您想要一个“仅限 vba”的答案，该答案可以扩展到任意数量的“集合”（也称为维度或类别）以及每组任意数量的成员，请参阅下面的答案。

【参考方案1】：

由于我提供了一种 ODBC 方法，我认为我应该详细说明它，因为如何做到这一点并不是很明显。而且，老实说，我需要重新学习这个过程并为自己记录下来。

这是一种使用 Excel 和 Microsoft Query 生成包含两个或多个一维数据数组的Cartesian product 的方法。

这些说明是使用 XL2007 编写的，但应在任何版本中进行微小（如果有）修改。

步骤 1

按列组织数组。

重要提示：每一列都应该有两个“标题”名称，如下面的粗体所示。最上面的名称稍后将被解释为“表名”。第二个名称将被解释为“列名”。这将在几步之后变得明显。

依次选择每个数据范围，包括两个“标题”，然后点击Ctrl+Shift+F3。在“创建名称”对话框中仅勾选Top row，然后单击OK。

一旦建立了所有命名范围，保存文件。

第二步

数据 |获取外部数据 |从其他来源 |来自微软查询

选择<New Data Source>。在Choose New Data Source 对话框中：

您的连接的友好名称

选择合适的 Microsoft Excel 驱动程序

...然后Connect

第三步

Select Workbook... 然后浏览您的文件。

第四步

从“表格”中添加“列”。您现在可以看到为什么第 1 步中的“双标头”布局很重要——它诱使驱动程序正确理解数据。

接下来点击Cancel（真的！）。此时可能会提示您“继续在 Microsoft Query 中编辑？” （回答Yes），或者无法在图形编辑器中表示加入的投诉。忽略这一点并继续努力......

第 5 步

Microsoft Query 将打开，默认情况下，您添加的表将被交叉连接。这将生成一个笛卡尔积，这正是我们想要的。

现在完全关闭 MSQuery。

第 6 步

您将返回到工作表。快完成了，我保证！勾选New worksheet和OK。

第 7 步

返回交叉连接的结果。

【讨论】：

好！或者，我通常这样做的方法是将列复制到 MS Access 中的表中，并以相同的方式在那里生成这些结果。然后可以轻松地将其复制回 Excel。

我也是+1。我希望我能给 +3 之类的东西，为了努力和清晰的解释

这太棒了。非常感谢安迪！

真的真的真的很酷！我用了 15 年的 excel 却不知道这个

【参考方案2】：

不知道你为什么不喜欢循环。请参阅此示例。不到一秒钟。

Option Explicit

Sub Sample()
    Dim i As Long, j As Long, k As Long, l As Long
    Dim CountComb As Long, lastrow As Long

    Range("G2").Value = Now

    Application.ScreenUpdating = False

    CountComb = 0: lastrow = 6

    For i = 1 To 4: For j = 1 To 4
    For k = 1 To 8: For l = 1 To 12
        Range("G" & lastrow).Value = Range("A" & i).Value & "/" & _
                                     Range("B" & j).Value & "/" & _
                                     Range("C" & k).Value & "/" & _
                                     Range("D" & l).Value
        lastrow = lastrow + 1
        CountComb = CountComb + 1
    Next: Next
    Next: Next

    Range("G1").Value = CountComb
    Range("G3").Value = Now

    Application.ScreenUpdating = True
End Sub

快照

注意：以上只是一个小例子。我对 4 列进行了测试，每列有 200 行。在这种情况下，可能的总组合是1600000000，耗时 16 秒。

在这种情况下，它会超过 Excel 行数限制。我能想到的另一种选择是在这种情况下将输出写入文本文件。如果您的数据很小，那么您可以在不使用数组并直接写入单元格的情况下摆脱困境。 :) 但是在大数据的情况下，我建议使用数组。

【讨论】：

嗨，悉达多，感谢您的回复。我面临的问题之一是输入列的数量可以并且将会变化。有时它是 13，有时是 6，有时是 12。我总是可以调整它，但我正在寻找不是一次性的东西。我很欣赏你的榜样，但肯定会帮助我朝着正确的方向前进。

您可以随时使用ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column 找到最后一列:)

【参考方案3】：

我自己多次需要这个并最终构建了它。

我相信代码可以扩展为任意总列数和列内任意数量的不同值（例如，每列可以包含任意数量的值）

它假设每一列中的所有值都是唯一的（如果这不是真的，你会得到重复的行）

它假设您要根据当前选择的任何单元格交叉连接输出（确保您选择所有单元格）

假设您希望输出在当前选择之后开始一列。

它是如何工作的（简要）： 首先针对每一列和每一行：它计算支持 N 列中所有组合所需的总行数（第 1 列中的项目 * 第 2 列中的项目 ... * 第 N 列中的项目）

每列的第二个：根据总组合数和前一列的总组合数计算两个循环。

ValueCycles（您必须循环浏览当前列中的所有值的次数） ValueRepeats（列中每个值连续重复多少次）

Sub sub_CrossJoin()

Dim rg_Selection As Range
Dim rg_Col As Range
Dim rg_Row As Range
Dim rg_Cell As Range
Dim rg_DestinationCol As Range
Dim rg_DestinationCell As Range
Dim int_PriorCombos As Long
Dim int_TotalCombos As Long
Dim int_ValueRowCount As Long
Dim int_ValueRepeats As Long
Dim int_ValueRepeater As Long
Dim int_ValueCycles As Long
Dim int_ValueCycler As Long

int_TotalCombos = 1
int_PriorCombos = 1
int_ValueRowCount = 0
int_ValueCycler = 0
int_ValueRepeater = 0

Set rg_Selection = Selection
Set rg_DestinationCol = rg_Selection.Cells(1, 1)
Set rg_DestinationCol = rg_DestinationCol.Offset(0, rg_Selection.Columns.Count)

'get total combos
For Each rg_Col In rg_Selection.Columns
    int_ValueRowCount = 0
    For Each rg_Row In rg_Col.Cells
        If rg_Row.Value = "" Then
            Exit For
        End If
        int_ValueRowCount = int_ValueRowCount + 1
    Next rg_Row
    int_TotalCombos = int_TotalCombos * int_ValueRowCount
Next rg_Col

int_ValueRowCount = 0

'for each column, calculate the repeats needed for each row value and then populate the destination
For Each rg_Col In rg_Selection.Columns
    int_ValueRowCount = 0
    For Each rg_Row In rg_Col.Cells
        If rg_Row.Value = "" Then
            Exit For
        End If
        int_ValueRowCount = int_ValueRowCount + 1
    Next rg_Row
    int_PriorCombos = int_PriorCombos * int_ValueRowCount
    int_ValueRepeats = int_TotalCombos / int_PriorCombos


    int_ValueCycles = (int_TotalCombos / int_ValueRepeats) / int_ValueRowCount
    int_ValueCycler = 0

    int_ValueRepeater = 0

    Set rg_DestinationCell = rg_DestinationCol

    For int_ValueCycler = 1 To int_ValueCycles
        For Each rg_Row In rg_Col.Cells
            If rg_Row.Value = "" Then
                Exit For
            End If

                For int_ValueRepeater = 1 To int_ValueRepeats
                    rg_DestinationCell.Value = rg_Row.Value
                    Set rg_DestinationCell = rg_DestinationCell.Offset(1, 0)
                Next int_ValueRepeater

        Next rg_Row
    Next int_ValueCycler

    Set rg_DestinationCol = rg_DestinationCol.Offset(0, 1)
Next rg_Col
End Sub

【参考方案4】：

基于我的第二条评论的解决方案。此示例假设您拥有三列数据，但可以进行调整以处理更多数据。

我从您的示例数据开始。为了方便起见，我在第一行添加了计数。我还添加了组合的总数（计数的乘积）。这是Sheet1：

在Sheet2:

公式：

A2:C2（橙色单元格）是硬编码的=0

A3=IF(SUM(B3:C3)=0,MOD(A2+1,Sheet1!$E$1),A2)

B3=IF(C3=0,MOD(B2+1,Sheet1!$G$1),B2)

C3=MOD(C2+1,Sheet1!$J$1)

D2=INDEX(Sheet1!$E$2:$E$5,Sheet2!A2+1)

E2=INDEX(Sheet1!$G$2:$G$6,Sheet2!B2+1)

F2=INDEX(Sheet1!$J$2:$J$5,Sheet2!C2+1)

从第 3 行向下填充与Total 在Sheet1 上显示的一样多的行

【讨论】：

您的解决方案可能更容易适应不同数量的列，但我不喜欢不必要的相对解决方案（其中每一行都根据前一行确定）。您可以使用绝对公式计算A、B 和C：A2 =INT((ROW()-2)/($G$1*$J$1))、B2 =MOD(INT((ROW()-2)/$J$1), $G$1) 和C2 =MOD((ROW()-2), $J$1)。 FWIW，您的公式将在 80 (4×5×4) 行之后换行，而我的将允许 Column A 无限制地增长；当然，这很容易解决。

【参考方案5】：

调用方法并放入当前级别，在方法中会递减（抱歉eng）

样本：

    sub MyAdd(i as integer)
      if i > 1 then
        MyAdd = i + MyAdd(i-1)
      else
        MyAdd = 1
      end if
    end sub