Excel vba创建Range的每个可能组合

Question

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

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

所有这些都不同，例如

E：
101％
105％
110％
120％

Y：
上S
上行L
下行B
高级V

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

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

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

Answer 1

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

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

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

第1步

按列组织数组。

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

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

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

第2步

数据|获取外部数据|来自其他来源|来自Microsoft Query

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

1. 您的连接的友好名称

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

...然后Connect



第3步

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



第4步

从“表格”中添加“列”。您现在可以看到为什么步骤1中的“两个标题”布局很重要 - 它会欺骗驱动程序正确理解数据。

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



第5步

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

现在完全关闭MSQuery。



第6步

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



第7步

返回交叉连接结果。

Answer 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行限制。我能想到的另一个选择是在这种情况下将输出写入文本文件。如果您的数据很小，那么您可以在不使用数组并直接写入单元格的情况下逃脱。 :)但是在大数据的情况下，我建议使用数组。

Answer 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

Answer 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所显示的行数

Answer 5

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

样品：

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