17

我有一个 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."

请帮忙！

4

3 回答 3

36

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

于 2012-05-11T21:07:58.057 回答
6

这听起来像一个整数问题

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

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

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

此信息直接来自MSDN

更新

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

那是 MSDN 具有误导性：VBA 本身不会将 Integer 转换为 Long。在幕后，CPU 将整数转换为 long，进行算术运算，然后将得到的 long 转换回整数。所以 VBA 整数仍然不能容纳大于 32K 的数字 – Charles Williams

于 2012-05-11T21:28:22.330 回答
2

您可以通过使用 For Each 而不是递增行来避免 Integer vs. 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
于 2012-05-12T16:06:05.903 回答