当VBA代码到达第1,048,576行时如何更改目标输出

Question

我正在尝试运行一个代码，该代码显示掷出8个骰子时的所有可能组合。问题是：几乎有170万种组合，而excel仅具有1,048,576行，因此VBA不断给我一个错误（运行时错误'1004'：对象'范围'的方法'偏移'失败）。如何解决此问题？

这是我的代码：

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 out() As Variant
Dim j, k, l, m, n, o, p, q, r 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 out1 As Range


Set col1 = Range("A1:A6")
Set col2 = Range("B1:B6")
Set col3 = Range("C1:C6")
Set col4 = Range("D1:D6")
Set col5 = Range("E1:E6")
Set col6 = Range("F1:F6")
Set col7 = Range("G1:G6")
Set col8 = Range("H1:H6")

c1 = col1
c2 = col2
c3 = col3
c4 = col4
c5 = col5
c6 = col6
c7 = col7
c8 = col8

Set out1 = Range("J2", Range("Q2").Offset(UBound(c1) * UBound(c2) * UBound(c3) * UBound(c4) * UBound(c5) * UBound(c6) * UBound(c7) * UBound(c8)))
out = out1

j = 1
k = 1
l = 1
m = 1
n = 1
o = 1
p = 1
q = 1
r = 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)
                            out(r, 1) = c1(j, 1)
                            out(r, 2) = c2(k, 1)
                            out(r, 3) = c3(l, 1)
                            out(r, 4) = c4(m, 1)
                            out(r, 5) = c5(n, 1)
                            out(r, 6) = c6(o, 1)
                            out(r, 7) = c7(p, 1)
                            out(r, 8) = c8(q, 1)
                            r = 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
out = out1
Loop

out1.Value = out
End Sub

我如何在循环中添加一条代码，当它达到1,048,576行时，应开始在一组不同的列中运行组合？理想情况下，一旦填写了J2-Q2，我希望它开始在T2-AA2列中运行代码。

Answer 1

我建议您尝试下一种方法。无论如何，大数据范围将需要很长时间...

Sub testCombinations_()
 '.......
 Dim out2 As Range, outBis As Variant, acceptR As Long
 Const maxR As Long = 1048575
 acceptR = UBound(c1) * UBound(c2) * UBound(c3) * UBound(c4) * UBound(c5) * UBound(c6) * UBound(c7) * UBound(c8)
 If acceptR > maxR Then
    Set out1 = Range("J2", Range("Q2").Offset(maxR))
    Set out2 = Range("T2", Range("AA2").Offset(acceptR - maxR))
    out = out1.value
    outBis = out2.value ' only for easy array dimensioning
 Else
    Set out1 = Range("J2", Range("Q2").Offset(acceptR))
    out = out1.value
 End If
 'follow your code...
 '..........
            Do While q <= UBound(c8)
                If r <= maxR Then
                    out(r, 1) = c1(j, 1)
                    out(r, 2) = c2(k, 1)
                    out(r, 3) = c3(L, 1)
                    out(r, 4) = c4(m, 1)
                    out(r, 5) = c5(n, 1)
                    out(r, 6) = c6(o, 1)
                    out(r, 7) = c7(p, 1)
                    out(r, 8) = c8(q, 1)
                    r = r + 1
                    q = q + 1
                    If r = maxR Then r = 1
                 Else
                    outBis(r, 1) = c1(j, 1)
                    outBis(r, 2) = c2(k, 1)
                    outBis(r, 3) = c3(L, 1)
                    outBis(r, 4) = c4(m, 1)
                    outBis(r, 5) = c5(n, 1)
                    outBis(r, 6) = c6(o, 1)
                    outBis(r, 7) = c7(p, 1)
                    outBis(r, 8) = c8(q, 1)
                    r = r + 1
                    q = q + 1
                 End If
            Loop
    '.........
    out1.value = out
    If UBound(outBis) > 1 Then out2.value = outBis
End Sub

[如同一般观察结果：Dim j, k, l, m, n, o, p, q, r As Long将使所有枚举As Variant变暗，只有最后一个As Long变暗。而且很难遵循如此长的垂直代码...对于所有垂直“排列”，我都将使用：j = 1: k = 1: l = 1:...等。垂直方式很好，并且只对少量变量使代码更清晰。当然不是必须的.​​..

当然，该代码未经测试，可能需要改进或更正...