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

Question

我有一个问题,我无法在网上的任何地方找到它(它可能在那里,但我找不到它,嘿).

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

所有这些都不一样,比如

E:
101%
105%
110%
120%

J:
Upper S
Upside L
Downside B
Premium V.

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

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

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

Answer 1

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

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

这些说明是使用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