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

Question

这里有几个关于 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

结束子

另外，作为说明，我尝试调整代码，以便我的输入从电子表格的顶部开始（A1 和我目前拥有的 A66），但这并没有帮助。此外，我知道在我用作参考的原始代码中，它列出了“Dim j As Long、k As Long、l As Long 等）并且我缩短了它，但我最初使用的是长格式，但仍然出现错误. 任何帮助将不胜感激。我是 VBA 的完全业余爱好者，所以如果错误很明显，我深表歉意。我试图研究错误代码，但我找不到我的具体为什么搞砸了。非常感谢你的时间。

非常尊重， T.

Answer 1

溢出意味着数字太高而无法存储为您想要的数据类型。 Offset 参数是 Long，因此最大输入值为 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 问题（希望如此），您仍然可能会得到比您的行数更大的东西，这需要很长时间。

编辑：顺便说一句，Dim i, j, k As Long 仅将最后一个变量设置为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

只需设置输入值的范围和输出的左上角单元格。

但请记住：如果j 出现溢出：有太多组合，处理起来实在是太多了。 （而且也永远不适合 1 张）
在这种情况下，将整个过程分成两个部分，然后告诉每个人将第二部分添加到第一部分中的每个项目中......可能没有人会这样做：P

如果你有任何问题，尽管问:)