Modifying Excel vba that creates all possible comb

2019-08-14 04:08发布

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

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

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

1条回答
仙女界的扛把子
2楼-- · 2019-08-14 04:22

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
查看更多
登录 后发表回答