Excel VBA FOR LOOP 在第 1000 次崩溃

Question

我正在尝试使用一些 VBA 代码来复制一系列单元格并将其值粘贴到下一个空行中 2111 次。

这成功粘贴到 754507 行，之后它崩溃了。

我可以在调试中看到它在第 1000 个循环处停止。

Option Explicit
Sub Paste_APIROWS()

Application.ScreenUpdating = False

Dim i As Long
Range("A2:H754").Copy
For i = 1 To 2111
    Range("A2:H754" & i).PasteSpecial Paste:=xlPasteValues
    Debug.Print i
    Next i

   Application.CutCopyMode = False

End Sub

我预计最终会有大约 1589583 行，但似乎只得到了其中的一半。

The error message I get is "Run-time error '1004': Method 'Range' of object'_Global' failed"

任何建议将不胜感激。

非常感谢。

Answer 1

在脑海中运行循环:

当i = 1 ，则范围为 "A2:H7541" (行 2 到 7,541)

当i = 2 ，则范围为 "A2:H7542" (行 2 到 7,542)

当i = 9 ，则范围为 "A2:H7549" (行 2 到 7,549)

当i = 10 ，则范围为 "A2:H75410" (行 2 到 75,410)

当i = 99 ，则范围为 "A2:H75499" (行 2 到 75,499)

当i = 100 ，则范围为 "A2:H754100" (行 2 到 754,100)

当i = 900 ，则范围为 "A2:H754900" (行 2 到 754,900)

当i = 999 ，则范围为 "A2:H754999" (行 2 到 754,999)

当i = 1000 ，则范围为 "A2:H7541000" (行 2 到 7,541,000)

注意 i 的每个值每经过 10 次方，行数就会增加一个数量级:

来自 i = 9至i = 10你从行 7,549至75,410

来自 i = 99至i = 100你从行 75,499至754,100

来自 i = 999至i = 1000你从行 754,100至7,541,000

另请注意，您的目标范围行始终为 2 - 所以在每次迭代中，你总是会覆盖自己。

它崩溃是因为 Excel 电子表格(自 Excel 2007 起)不能超过 1,048,576行，因此崩溃。限制为 65,355在 Excel 2007 之前或在现代版本的 Excel 中使用非 OOXML 电子表格时)。

I expect in the end to have about 1,589,583 rows but instead appear to be only getting about half of this.

两件事情:

Excel 不支持 1,589,583无论如何行(如前所述，最大值为 1,048,576 )。

根据我上面的解释，您的逻辑没有正确计算复制目标范围。

您的错误的原因是使用字符串连接(即 & 运算符)而不是数字加法。

您想复制 A2:H754 范围内的单元格一些 2111 1930 次 - 这意味着你实际上想要这样做:

Const sourceRowLB =   2
Const sourceRowUB = 755 ' 755 not 754 because exclusive upper-bounds are easier to work with
Dim sourceRowCount = sourceRowUB - sourceRowLB

Dim lastCopyUB = 755

Dim sourceRangeExpr = GetRangeExpr( "A", sourceRowLB, "H", sourceRowUB ) ' Will be "A2:H754"
Range( sourceRangeExpr  ).Copy

Const loopCount As Integer = 1389 ' This cannot be 2111 because ( 2111 * 754 ) exceeds the maximum row count
For i = 1 ToloopCount ' Loop 1389 times

    ' Recompute the destination range:
    Dim destRowLB As Integer
    destRowLB = lastCopyUB
    Dim destRowUB As Integer
    destRowUB = destRowLB + sourceRowCount

    Dim rangeExpression As String
    rangeExpression = GetRangeExpr( "A", destRowLB, "H" & destRowUB )

    Range( rangeExpression ).PasteSpecial Paste:=xlPasteValues

    lastCopyUB = destRowUB

Next i

Function GetRangeExpr(startCol As String, startRow As Integer, endCol As String, endRowExclUB As Integer) As String

    GetRangeExpr = startCol  & CStr( destRowLB ) & ":" & endCol & CStr( endRowExclUB  - 1 ) ' We convert endRowExclUB to an inclusive upper-bound here

End Function