这里有几个关于VBA代码的对话,以在Excel中查找具有不同数据长度的多个列之间的所有可能组合。对话包括3列,4列和5列,但我需要使用14列进行此操作。这个对话中给出的5列代码是我使用的: VBA - Write all possible combinations of 4 columns of data 但是我收到以下错误:"运行时错误' 6':溢出"当我去调试时它会突出显示这一行:
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个列中找到的示例中调整的完整代码:
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
End Sub
另外,作为一个注释,我尝试调整代码,以便我的输入开始在电子表格的顶部(A1副A66我目前有),这没有帮助。另外,我知道在我用作参考的原始代码中它列出了&#34; Dim j As Long,k As Long,l As Long等)并且我缩短了它,但我最初使用了长形而且仍然得到了错误。任何帮助将不胜感激。我是VBA的全体业余爱好者,所以如果错误很明显,我很抱歉。我试图研究错误代码,但我无法找到为什么我的具体搞乱了。非常感谢您的时间。
非常尊重, 吨。
答案 0 :(得分:2)
溢出意味着该数字太高而无法存储为您希望的数据类型。 Offset
参数是Long
,因此最大输入值为2147483648,因为它不会导致溢出。既然你说你的最大列大小是8而且只有8个非平凡的列,那么就必须有其他的东西。
具有讽刺意味的是,问题是由只有一个条目的列引起的:)
您正在设置如下列:
Set col1 = Range("A66", Range("A66").End(xlDown))
我不打算这样做但是如果&#34; A66&#34;是该列中具有条目的最后一个单元格,.End(xlDown)
将一直向下到表格的底部。这就是你的高数字来自哪里。
使用Cells(rows.count,1).End(xlUp)
查找A列中的最后一个非空单元格:
Set col1 = Range("A66", Cells(rows.count,1).End(xlUp))
当然这只解决了Overflow
问题(希望如此),你可能最终会得到比你的行计数更长的东西,这需要花费很长时间。
编辑:顺便说一下,Dim i, j, k As Long
只将最后一个变量设置为Long
,其他变量设置为Variant
。它与
Dim i
Dim j
Dim k as Long
答案 1 :(得分:0)
你可以通过以下方式做到这一点:
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
只需设置输入值的范围和输出的左上角单元格。
但请记住:如果j
出现溢出:有很多组合,只需要处理很多。 (并且也永远不会适合1张)
在这种情况下,将整个过程分成2个部分,然后告诉大家将第二部分添加到第一部分中的每个项目......可能没有人会这样做:P
如果您有任何疑问,请询问:)