修改Excel vba，創建多個列表中的所有可能的組合

Question

你好，我發現幾年前的一些非常棒的代碼可以從多行創建所有可能的組合。它工作的很好，但是當你用更多的數據嘗試它時，它會返回運行時錯誤6溢出。我對VBA很陌生，但我希望有一種方法可以分解或減慢進程以保持宏運行。我目前的數據應該會產生442,368個獨特的行，這在很大程度上屬於excel的功能範圍。我將粘貼下面的vba代碼。當您在錯誤之後點擊調試時，它會突出顯示此行：int_TotalCombos = int_TotalCombos * int_ValueRowCount
我真的很感謝任何人都可以提供的幫助。謝謝！

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 to create every possible combination of a Range

Spioter還提供了以下信息的響應：

「我相信的列的任何總數和列內的任何數量的不同值（代碼尺度例如每列可以包含任何數量的值）

它假定每列的所有值是唯一的（如果這是不正確的，你會得到重複行）

它假定你要根據你擁有的任何細胞交叉聯接輸出目前選擇（確保您選擇t全部）

它假定您希望輸出在當前選擇之後開始一列。

它是如何工作的（簡要地）：首先爲每一列和每一行：它計算支持N列中所有連擊所需的總行數（第1列中的項目*第2列中的項目... *項目在N列中）

每列第二個：基於總組合，以及先前列的總組合計算兩個循環。

ValueCycles（你多少次通過在當前列中的所有值必須循環）ValueRepeats（多少次列重複每個值連續）「

Answer 1

更改整數聲明數據類型龍。整型擁有大約32,000限制那張長近2十億

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

您可能會想他們在整個代碼命名，所以名字中的數據類型相匹配：。

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