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

这听起来像的整数问题

的整数和长数据类型可以都保持正或负 值。它们之间的差异是它们的大小：整数变量 可以保持在-32768和32,767,之间的值，而长变量可以是 的范围从-2,147,483,648到2,147,483,647。

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

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

此信息是直接从MSDN

UPDATE

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

这就是MSDN误导：VBA本身并不将整数转换为 长。在CPU的掩护下，CPU将整数转换为long，然后执行 算术运算，然后将结果long转换为整数。所以 VBA整数仍不能持有数量大于32K - Charles Williams

Answer 3

您可以通过使用一个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