使用VBA在Excel中组合来自十四列的数据的所有组合

在这里有一些关于VBA代码的对话，可以在Excel中查找具有不同长度数据的多列之间的所有可能的组合。 对话包括3,4,5列，但我需要做14列。 在这个对话中给出的5列代码是我所使用的： VBA – 写入所有可能的4列数据的组合但我得到以下错误：“运行时错误”6：溢出“，它突出显示此行时我去debugging：

Set out1 = Range("G2", Range("K2").Offset(UBound(c1) * UBound(c2) * UBound(c3) * UBound(c4) * UBound(c5) * UBound(c6) * UBound(c7) * UBound(c8) * UBound(c9) * UBound(c10) * UBound(c11) * UBound(c12) * UBound(c13) * UBound(c14))) 

这里是我从5列find的例子中调整的完整代码：

 Sub combinations() 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 c8() As Variant Dim c9() As Variant Dim c10() As Variant Dim c11() As Variant Dim c12() As Variant Dim c13() As Variant Dim c14() As Variant Dim out() As Variant Dim j, k, l, m, n, o, p, q, r, s, t, u, v, w, x 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 col8 As Range Dim col9 As Range Dim col10 As Range Dim col11 As Range Dim col12 As Range Dim col13 As Range Dim col14 As Range Dim out1 As Range Set col1 = Range("A66", Range("A66").End(xlDown)) Set col2 = Range("B66", Range("B66").End(xlDown)) Set col3 = Range("C66", Range("C66").End(xlDown)) Set col4 = Range("D66", Range("D66").End(xlDown)) Set col5 = Range("E66", Range("E66").End(xlDown)) Set col6 = Range("F66", Range("F66").End(xlDown)) Set col7 = Range("G66", Range("G66").End(xlDown)) Set col8 = Range("H66", Range("H66").End(xlDown)) Set col9 = Range("I66", Range("I66").End(xlDown)) Set col10 = Range("J66", Range("J66").End(xlDown)) Set col11 = Range("K66", Range("K66").End(xlDown)) Set col12 = Range("L66", Range("L66").End(xlDown)) Set col13 = Range("M66", Range("M66").End(xlDown)) Set col14 = Range("N66", Range("N66").End(xlDown)) c1 = col1 c2 = col2 c3 = col3 c4 = col4 c5 = col5 c6 = col6 c7 = col7 c8 = col8 c9 = col9 c10 = col10 c11 = col11 c12 = col12 c13 = col13 c14 = col14 Set out1 = Range("P66", Range("AC66").Offset(UBound(c1) * UBound(c2) * UBound(c3) * UBound(c4) * UBound(c5) * UBound(c6) * UBound(c7) * UBound(c8) * UBound(c9) * UBound(c10) * UBound(c11) * UBound(c12) * UBound(c13) * UBound(c14))) out = out1 j = 1 k = 1 l = 1 m = 1 n = 1 o = 1 p = 1 q = 1 r = 1 s = 1 t = 1 u = 1 v = 1 w = 1 x = 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) Do While q <= UBound(c8) Do While r <= UBound(c9) Do While s <= UBound(c10) Do While t <= UBound(c11) Do While u <= UBound(c12) Do While v <= UBound(c13) Do While w <= UBound(c14) out(o, 1) = c1(j, 1) out(o, 2) = c2(k, 1) out(o, 3) = c3(l, 1) out(o, 4) = c4(m, 1) out(o, 5) = c5(n, 1) out(o, 6) = c6(o, 1) out(o, 7) = c7(p, 1) out(o, 8) = c8(q, 1) out(o, 9) = c9(r, 1) out(o, 10) = c10(s, 1) out(o, 11) = c11(t, 1) out(o, 12) = c12(u, 1) out(o, 13) = c13(v, 1) out(o, 14) = c14(w, 1) x = x + 1 w = w + 1 Loop w = 1 v = v + 1 Loop v = 1 u = u + 1 Loop u = 1 t = t + 1 Loop t = 1 s = s + 1 Loop s = 1 r = r + 1 Loop r = 1 q = q + 1 Loop 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 

结束小组

此外，作为一个说明，我试着调整代码，使我的input开始在电子表格的顶部（A1副A66我目前有），并没有帮助。 此外，我知道在我用作参考的原始代码中，列出了“Dim j As Long，k As Long，l As Long等等），并且缩短了它，但是我原本使用了long-form，并且还是得到了错误任何帮助将不胜感激。我是一个总是业余的VBA，所以我很抱歉，如果错误是显而易见的。我试图研究错误代码，但我找不到为什么我特别搞乱了。非常感谢您的时间。

非常尊重，T.

Answer 1

溢出表示该数字太高，无法存储为您希望的数据types。 Offset参数是一个Long所以最大input值是2147483648，它不会导致溢出。 既然你说你的最大列大小是8，而且只有8个非平凡的列，那么还有其他的事情要做。

具有讽刺意味的是，问题是由只有一个项目的列造成的:)

你正在设置这样的列：

 Set col1 = Range("A66", Range("A66").End(xlDown)) 

我不打算进去，但如果“A66”是在该列中有一个条目的最后一个单元格，则.End(xlDown)将一直下到表单的底部。 这是你的高数字来自哪里。

使用Cells(rows.count,1).End(xlUp)来查找列A中的最后一个非空单元格：

 Set col1 = Range("A66", Cells(rows.count,1).End(xlUp)) 

当然，这只会修复Overflow问题（希望），但最终可能会比行计数长一些。

编辑：btw， Dim i, j, k As Long只将最后一个variables设置为Long ，其他设置为Variant 。 这是一样的

 Dim i Dim j Dim k as Long 

Answer 2

你可以做这个变化很多，有：

 Option Explicit Sub test() Dim inputRng As Range Set inputRng = ThisWorkbook.Sheets("Sheet1").Range("A2:E5") 'change this to fit your needs Dim inputVal() As Variant ReDim inputVal(1 To inputRng.Columns.Count) Dim holder() As Variant Dim i, j, k, xCol, xRow j = 1: k = 1 'load in values For Each xCol In inputRng.Columns If Len(xCol.Cells(2, 1)) Then xRow = xCol.Cells(1, 1).End(xlDown).Row Else xRow = xCol.Cells(1, 1).Row End If If xRow > (xCol.Rows.Count + xCol.Row - 1) Then xRow = (xCol.Rows.Count + xCol.Row - 1) ReDim holder(0 To xRow - xCol.Cells(1, 1).Row + 1) holder(0) = UBound(holder) j = j * holder(0) For i = 1 To holder(0) holder(i) = xCol.Cells(i).Value Next inputVal(k) = holder k = k + 1 Next Dim outputVal() As Variant ReDim outputVal(1 To j, 1 To inputRng.Columns.Count) k = 1 For i = UBound(outputVal, 2) To 1 Step -1 For j = 0 To UBound(outputVal) - 1 outputVal(j + 1, i) = inputVal(i)((Int(j / k) Mod inputVal(i)(0)) + 1) Next k = k * inputVal(i)(0) Next Dim outputRng As Range Set outputRng = ThisWorkbook.Sheets("Sheet1").Range("G1") 'set here the first cell to start output outputRng.Resize(UBound(outputVal), UBound(outputVal, 2)).Value = outputVal End Sub 

只需为输出设置input值的范围和左上方的单元格。

但请记住：如果j溢出：有这么多的组合，它只是要处理很多。 （也绝不适合1张）
在这种情况下，把整个过程分成两个部分，然后告诉每个人把第二部分加到第一部分的每个项目中……可能没人会这样做：P

如果你有问题，就问吧 ：）