修改Excel vba以从多个列表创建所有可能的组合 [英] Modifying Excel vba that creates all possible combinations from multiple lists

问题描述

您好，我发现了几年前的一些很棒的代码，可以从多行创建所有可能的组合.它工作得很好，但是当您尝试使用更多数据时，它将返回运行时错误6溢出.我是VBA的新手，但希望有一种方法可以拆分或减慢该过程以保持宏运行.我当前的数据应该产生442,368个唯一行，这虽然很多，但是完全在excel的能力范围内.我将在下面粘贴vba代码.当您在错误后执行调试时，该错误将突出显示以下行: int_TotalCombos = int_TotalCombos * int_ValueRowCount
我真的很感激任何人都可以提供的帮助.谢谢！

Hello I found some really great code from a couple years ago to create all possible combinations from multiple rows. It works great but as you try it with more data it returns a run time error 6 overflow. I am very new to VBA but am hoping that there is a way to split up or slow the process down to keep the macro running. My current data should produce 442,368 unique rows, which is a lot but well within the scope of excel's power. I will paste the vba code below. When you hit debug following the error it highlights this row: int_TotalCombos = int_TotalCombos * int_ValueRowCount
I really would appreciate any help anyone can provide. Thank you!

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 Integer
Dim int_TotalCombos As Integer
Dim int_ValueRowCount As Integer
Dim int_ValueRepeats As Integer
Dim int_ValueRepeater As Integer
Dim int_ValueCycles As Integer
Dim int_ValueCycler As Integer

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

这里是我找到它的地方的链接.查看"Spioter"的回复 Excel vba可以创建范围的所有可能组合

Here is a link to where i found it. See the response by 'Spioter' Excel vba to create every possible combination of a Range

Spioter还提供了以下信息:

Spioter also provided the following information:

我相信代码可以缩放到任意数量的列总数和列中任意数量的不同值(例如，每列可以包含任意数量的值)

"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.

工作原理(简要):首先针对每一列和每一行:计算支持N列中所有组合所需的总行数(第1列中的项目*第2列中的项目... * N列)

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)

秒:根据总组合和前几列的总组合，计算两个循环.

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

ValueCycles(必须在当前列中的所有值之间循环多少次)ValueRepeats(要连续重复该列中的每个值多少次)"

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) "

推荐答案

将Integer声明更改为数据类型Long.整数的上限约为32,000.远远超过20亿.

Change the Integer declarations to data type Long. Integer has a limit of around 32,000. Long goes past 2 billion.

Dim int_PriorCombos As Long
Dim int_TotalCombos As Long
Dim int_ValueRowCount As Long
' and so on for the other integers

您可能需要在整个代码中重命名它们，因此名称与数据类型匹配:

You'll probably want to rename them throughout the code, so the name matches the data type:

Dim lng_PriorCombos As Long
Dim lng_TotalCombos As Long
Dim lng_ValueRowCount As Long

这篇关于修改Excel vba以从多个列表创建所有可能的组合的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！