修改从多个列表创build所有可能组合的Excel vba

你好，我从几年前发现了一些非常好的代码来创build多行的所有可能的组合。 它工作的很好，但是当你用更多的数据尝试时，它会返回运行时错误6溢出。 我对VBA很新，但是希望有一种方法可以分解或减慢进程，保持macros运行。 我目前的数据应该会产生442368个独特的行，这是很好的，但是在excel的能力范围之内。 我将粘贴下面的vba代码。 当你按照错误点击debugging时，它突出显示了这一行： 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 

这里是我find它的链接。 请参阅“Spioter” Excel vba的响应， 以创buildRange的各种可能组合

Spioter还提供了以下信息：

“我相信代码可以对任何列的总数和列内任意数量的不同值进行缩放（例如，每列可以包含任意数量的值）

它假定每列中的所有值都是唯一的（如果不是这样，则会得到重复的行）

它假设你想交叉连接输出基于你当前select的任何单元格（确保你全部选中）

它假定您希望输出在当前select之后开始一列。

它是如何工作的（简单地说）：首先为每一列和每一行：它计算支持所有组合在N列中所需的总行数（列1中的项目*列2中的项目*列中的项目*

每列第二：基于总的组合，以及以前列的总组合计算两个循环。

ValueCycles（您必须循环显示当前列中所有值的次数）ValueRepeats（连续重复列中每个值的次数）“

Answer 1

将整数声明更改为数据typesLong。 Integer有大约32,000的限制。 龙超过20亿。

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

您可能需要在整个代码中重命名它们，所以名称与数据types相匹配：

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