溢出错误与macros来想出列项目的所有可能的组合

所以我有这个循环遍历7列的macros，并返回7个其他列包含前7列的每个组合。

我遇到的错误是我用上限来获取列表中的项目数量。 我不知道为什么，但是当列中只有一个项目时出现溢出错误。 我认为VBA并不是做这件事的最好方法，但是我们对数据的其余工作是在Excel中完成的，所以只要保持closures就容易了。

它在这一行溢出Set out1 = Range（“K2”，Range（“Q2”）。Offset（UBound（c1）* UBound（c2）* UBound（c3）* UBound（c4）* UBound（c5）* UBound c6）* UBound（c7）））

我在StackOverflow上发现了一个相同的组合问题的recursion解决scheme，但是当列只有1个项目时，会遇到同样的问题。 我应该怎么办？ 我认为它必须是没有计算上限的东西。 这是代码。

Sub Final() Dim c1() As Variant Dim c2() As Variant Dim c3() As Variant Dim c4() As Variant Dim c5() As Variant Dim c6() As Variant Dim c7() As Variant Dim out() As Variant Dim j, k, l, m, n, o, p, q As Long Dim col1 As Range Dim col2 As Range Dim col3 As Range Dim col4 As Range Dim col5 As Range Dim col6 As Range Dim col7 As Range Dim out1 As Range Set col1 = Range("A2", Range("A2").End(xlDown)) Set col2 = Range("B2", Range("B2").End(xlDown)) Set col3 = Range("C2", Range("C2").End(xlDown)) Set col4 = Range("D2", Range("D2").End(xlDown)) Set col5 = Range("E2", Range("E2").End(xlDown)) Set col6 = Range("F2", Range("F2").End(xlDown)) Set col7 = Range("G2", Range("G2").End(xlDown)) c1 = col1 c2 = col2 c3 = col3 c4 = col4 c5 = col5 c6 = col6 c7 = col7 Set out1 = Range("K2", Range("Q2").Offset(UBound(c1) * UBound(c2) * UBound(c3) * UBound(c4) * UBound(c5) * UBound(c6) * UBound(c7))) out = out1 j = 1 k = 1 l = 1 m = 1 n = 1 o = 1 p = 1 q = 1 Do While j <= UBound(c1) Do While k <= UBound(c2) Do While l <= UBound(c3) Do While m <= UBound(c4) Do While n <= UBound(c5) Do While o <= UBound(c6) Do While p <= UBound(c7) out(q, 1) = c1(j, 1) out(q, 2) = c2(k, 1) out(q, 3) = c3(l, 1) out(q, 4) = c4(m, 1) out(q, 5) = c5(n, 1) out(q, 6) = c6(o, 1) out(q, 7) = c7(p, 1) q = q + 1 p = p + 1 Loop p = 1 o = o + 1 Loop o = 1 n = n + 1 Loop n = 1 m = m + 1 Loop m = 1 l = l + 1 Loop l = 1 k = k + 1 Loop k = 1 j = j + 1 Loop out1.Value = out 

谢谢你的帮助。 而且我知道这不是最好的代码，但它的工作原理。

解

  Set col1 = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp)) Set col2 = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp)) Set col3 = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp)) Set col4 = Range(Range("D2"), Range("D" & Rows.Count).End(xlUp)) Set col5 = Range(Range("E2"), Range("E" & Rows.Count).End(xlUp)) Set col6 = Range(Range("F2"), Range("F" & Rows.Count).End(xlUp)) Set col7 = Range(Range("G2"), Range("G" & Rows.Count).End(xlUp)) If col1.Cells.Count = 1 Then ReDim c1(1 To 1, 1 To 1) c1(1, 1) = col1.Value Else c1 = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp)) End If If col2.Cells.Count = 1 Then ReDim c2(1 To 1, 1 To 1) c2(1, 1) = col1.Value Else c2 = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp)) End If If col3.Cells.Count = 1 Then ReDim c3(1 To 1, 1 To 1) c3(1, 1) = col3.Value Else c3 = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp)) End If If col4.Cells.Count = 1 Then ReDim c4(1 To 1, 1 To 1) c4(1, 1) = col4.Value Else c4 = Range(Range("D2"), Range("D" & Rows.Count).End(xlUp)) End If If col5.Cells.Count = 1 Then ReDim c5(1 To 1, 1 To 1) c5(1, 1) = col5.Value Else c5 = Range(Range("E2"), Range("E" & Rows.Count).End(xlUp)) End If If col6.Cells.Count = 1 Then ReDim c6(1 To 1, 1 To 1) c6(1, 1) = col6.Value Else c6 = Range(Range("F2"), Range("F" & Rows.Count).End(xlUp)) End If If col7.Cells.Count = 1 Then ReDim c7(1 To 1, 1 To 1) c7(1, 1) = col7.Value Else c7 = Range(Range("G2"), Range("G" & Rows.Count).End(xlUp)) End If 

这reDims数组是1 1，所以他们匹配1单元格的范围。 适用于1+项目。 感谢大家的帮助。