VBA 宏在 32000 行后崩溃

Question

我有一个 VBA 宏，它根据在 3 列中的单元格中查找值将行从一个工作表复制到另一个工作表。宏有效，但在到达第 32767 行时崩溃。此行中没有公式或特殊格式。此外，我已经删除了该行，但它仍然在该行号上崩溃。这是excel的限制吗？正在处理的工作表中有大约 43000 个

因此，我问我的宏有什么问题以及如何让它到达工作表的末尾：

Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim wks As Worksheet
On Error GoTo Err_Execute

对于工作表中的每个周

LSearchRow = 4
LCopyToRow = 4

ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
Set wksCopyTo = ActiveSheet
wks.Rows(3).EntireRow.Copy wksCopyTo.Rows(3)

While Len(wks.Range("A" & CStr(LSearchRow)).Value) > 0

    If wks.Range("AB" & CStr(LSearchRow)).Value = "Yes" And wks.Range("AK" & CStr(LSearchRow)).Value = "Yes" And wks.Range("BB" & CStr(LSearchRow)).Value = "Y" Then

        Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
        Selection.Copy


        wksCopyTo.Select
        wksCopyTo.Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
        wksCopyTo.Paste

        'Move counter to next row
        LCopyToRow = LCopyToRow + 1
        'Go back to Sheet1 to continue searching
        wks.Select
    End If
    LSearchRow = LSearchRow + 1
Wend

Application.CutCopyMode = False
Range("A3").Select
MsgBox "All matching data has been copied."
Next wks
    Exit Sub
Err_Execute:
    MsgBox "An error occurred."

请帮忙！

Answer 1

VBA 'Int' 类型是带符号的 16 位字段，因此它只能保存从 -32768 到 +32767 的值。将这些变量更改为“Long”，这是一个带符号的 32 位字段，可以保存从 -2147483648 到 +2147483647 的值。 Excel应该足够了。 ;)

Answer 2

这听起来像是一个整数问题

Integer 和 Long 数据类型都可以是正数或负数 价值观。它们之间的区别在于它们的大小：整数变量 可以保存 -32,768 和 32,767 之间的值，而 Long 变量可以 范围从 -2,147,483,648 到 2,147,483,647。

但是您使用的是哪个版本？因为：

传统上，VBA 程序员使用整数来保存小数字，因为它们 需要更少的内存。然而，在最近的版本中，VBA 将所有 Long 类型的整数值，即使它们被声明为类型 整数。因此，不再有性能优势 使用整数变量；事实上，Long 变量可能会稍微 更快，因为 VBA 不必转换它们。

此信息直接来自MSDN

更新

还请阅读第一条评论！我以错误的方式解释了 MSDN 信息！

那是 MSDN 的误导：VBA 本身不会将 Integer 转换为 长。在幕后，CPU将整数转换为长整数， 算术，然后将结果 long 转换回整数。所以 VBA 整数仍然不能容纳大于 32K 的数字 – Charles Williams

Answer 3

您可以通过使用 For Each 而不是递增行来避免整数与长的问题。 For Each 通常更快，避免选择范围也是如此。这是一个例子：

Sub CopySheets()

    Dim shSource As Worksheet
    Dim shDest As Worksheet
    Dim rCell As Range
    Dim aSheets() As Worksheet
    Dim lShtCnt As Long
    Dim i As Long

    Const sDESTPREFIX As String = "dest_"

    On Error GoTo Err_Execute

    For Each shSource In ThisWorkbook.Worksheets
        lShtCnt = lShtCnt + 1
        ReDim Preserve aSheets(1 To lShtCnt)
        Set aSheets(lShtCnt) = shSource
    Next shSource

    For i = LBound(aSheets) To UBound(aSheets)
        Set shSource = aSheets(i)

        'Add a new sheet
        With ThisWorkbook
            Set shDest = .Worksheets.Add(, .Worksheets(.Worksheets.Count))
            shDest.Name = sDESTPREFIX & shSource.Name
        End With

        'copy header row
        shSource.Rows(3).Copy shDest.Rows(3)

        'loop through the cells in column a
        For Each rCell In shSource.Range("A4", shSource.Cells(shSource.Rows.Count, 1).End(xlUp)).Cells
            If Not IsEmpty(rCell.Value) And _
                rCell.Offset(0, 27).Value = "Yes" And _
                rCell.Offset(0, 36).Value = "Yes" And _
                rCell.Offset(0, 53).Value = "Yes" Then

                'copy the row
                rCell.EntireRow.Copy shDest.Range(rCell.Address).EntireRow
            End If
        Next rCell
    Next i

    MsgBox "All matching data has been copied."

Err_Exit:
    'do this stuff even if an error occurs
    On Error Resume Next
    Application.CutCopyMode = False
    Exit Sub

Err_Execute:
    MsgBox "An error occurred."
    Resume Err_Exit

End Sub