Question

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

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

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

对于工作表中的每个wks

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

这听起来像一个整数问题

整数和长数据类型都可以保持正数或负数值。它们之间的区别在于它们的大小：整数变量可以保持 -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，执行算术然后将得到的long转换回整数。所以 VBA整数仍然不能容纳大于32K的数字 - Charles Williams

Answer 3

您可以使用For Each而不是递增行来避免Integer与Long问题。 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

32000行后VBA宏崩溃

3 个答案: