32000行后VBA宏崩溃

时间:2012-05-11 20:58:24

标签: excel vba excel-vba

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

请帮忙!

3 个答案:

答案 0 :(得分:32)

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

答案 1 :(得分:6)

这听起来像一个整数问题

  

整数和长数据类型都可以保持正数或负数   值。它们之间的区别在于它们的大小:整数变量   可以保持 -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

答案 2 :(得分:2)

您可以使用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