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

Excel vba to create every possible combination of a Range

提问by Kelvin

I have a problem that I haven't been able to find anywhere on the web (it may be there, but I can't find it, heh).

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

I have a spreadsheet with 13 columns of data. Each of the column contains variations of a parameter that needs to go into an overall test case.

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

All of them differ, like

他们都不同，比如

E:
101%
105%
110%
120%

E:
101%
105%
110%
120%

J:
Upper S
Upside L
Downside B
Premium V

J：
上 S 上
L
下 B
溢价 V

I have seen several solutions to the combination issue which uses nested loops. I'd like to steer clear of 13 nested loops (but this is my best bet at the moment). I'm kind of at a loss on how to generate every unique combination in in each column.

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

I'm not sure if that makes enough sense for you guys. I was hoping someone could at least point me in the right direction with a recursive algorithm. I'd like to make it dynamic enough to take varying numbers of columns and rows.

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

Thanks for any help you guys can give me.

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

回答by andy holaday

Since I offered an ODBC approach I thought I should elaborate on it, as it is not immediately obvious how to do this. And, in honesty, I needed to relearn the process and document it for myself.

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

This is a way to generate a Cartesian productof two or more one-dimensional data arrays using Excel and Microsoft Query.

这是一种使用 Excel 和 Microsoft Query生成两个或多个一维数据数组的笛卡尔积的方法。

These instructions were written with XL2007 but should work with minor (if any) modifications in any version.

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

Step 1

第1步

Organize the arrays in columns.

按列组织数组。

Important:Each column should have two "header" names as shown in bold below. The topmost name will later be interpreted as a "table name". The second name will be interpreted as a "column name". This will become apparent a few steps later.

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

Select each data range in turn, including both "headers", and hit Ctrl+Shift+F3. Tick only Top rowin the 'Create Names" dialog and click OK.

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

Once all named ranges are established, save the file.

建立所有命名范围后，保存文件。

Step 2

第2步

Data | Get External Data | From Other Sources | From Microsoft Query

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

Choose <New Data Source>. In the Choose New Data Sourcedialog:

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

1. A friendly name for your connection

2. choose the appropriate Microsoft Excel driver

1. 您的连接的友好名称

2. 选择合适的 Microsoft Excel 驱动程序

... then Connect

... 然后 Connect

Step 3

第 3 步

Select Workbook...then browse for your file.

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

Step 4

第四步

Add the "columns" from your "tables". You can see now why the "two header" layout in step 1 is important--it tricks the driver into understanding the data correctly.

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

Next click Cancel(really!). You might be prompted at this point to "continue editing in Microsoft Query?" (answer Yes), or a complaint that joins cannot be represented in the graphical editor. Ignore this and forge on...

下一步点击Cancel（真的！）。此时可能会提示您“继续在 Microsoft Query 中编辑？” (answer Yes)，或无法在图形编辑器中表示加入的投诉。忽略这一点，继续前进……

Step 5

第 5 步

Microsoft Query opens, and by default the tables you added will be cross-joined. This will generate a Cartesian product, which is what we want.

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

Now close MSQuery altogether.

现在完全关闭 MSQuery。

Step 6

第 6 步

You are returned to the worksheet. Almost done, I promise! Tick New worksheetand OK.

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

Step 7

第 7 步

The cross-joined results are returned.

返回交叉连接的结果。

回答by Siddharth Rout

Not sure why you are averse to looping. See this example. It took less than a second.

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

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

SNAPSHOT

快照

NOTE: The above was a small example. I did a test on 4 columns with with 200 rows each. The total combination possible in such a scenario is 1600000000and it took 16 seconds.

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

In such a case it crosses the Excel rows limit. One other option that I can think of is writing the output to a text file in such a scenario. If your data is small then you can get away without using arrays and directly writing to the cells. :) But in case of large data, I would recommend using arrays.

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

回答by spioter

I needed this myself several times and finally built it.

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

I believe the code scales for any total number of columns and any number of distinct values within columns (e.g. each column can contain any number of values)

我相信代码可以针对任意总数的列和任意数量的列中的不同值进行缩放（例如，每列可以包含任意数量的值）

It assumes all values in each column are unique (if this is not true, you will get duplicate rows)

它假设每列中的所有值都是唯一的（如果不是这样，您将获得重复的行）

It assumes you want to cross-join output based on whatever cells you have currently selected (make sure you select them all)

它假设您想根据当前选择的任何单元格交叉连接输出（确保全部选择它们）

It assumes you want the output to start one column after the current selection.

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

How it works (briefly): first for each column and for each row: It calculates the number of total rows needed to support all combos in N columns (items in column 1 * items in column 2 ... * items in column N)

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

second for each column: Based on the total combos, and the total combos of the previous columns it calculates two loops.

每列第二个：基于总组合和前一列的总组合，它计算两个循环。

ValueCycles (how many times you have to cycle through all the values in the current column) ValueRepeats (how many times to repeat each value in the column consecutively)

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

回答by andy holaday

Solution based on my second comment. This example assumes you have three columns of data but can be adapted to handle more.

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

I start with your sample data. I added counts on the top row for convenience. I also added the total number of combinations (product of the counts). This is Sheet1:

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

On Sheet2:

在Sheet2：

Formulae:

公式：

A2:C2(orange cells) are hard coded =0

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

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

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

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

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

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

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

Fill from row 3 down as many rows as Totalshows on Sheet1

从第 3 行向下填充Total显示的行数Sheet1

回答by NDavid RU

call the method and put into the current level, which will be decremented in the method (sorry for eng)

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

sample:

样本：

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