VBAmacros在32000行后崩溃
我有一个VBAmacros,从一个工作表中的行复制到另一个基于查找3列中的单元格中的值。 macros工作,但到达行32767时崩溃。在这一行没有公式或特殊格式。 此外,我已经把这一行,但它仍然在该行号崩溃。 这是Excel中的限制吗? 正在处理的工作表中有43000个
因此,我问我的macros有什么问题,以及如何让它达到工作表的末尾:
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."
请帮忙!
VBA“内部”types是一个有符号的16位字段,因此它只能保存从-32768到+32767的值。 将这些variables更改为“Long”,这是一个有符号的32位字段,可以保存从-2147483648到+2147483647的值。 应该足够Excel。 ;)
这听起来像一个整数问题
Integer和Long数据types都可以保存正值或负值。 它们之间的区别在于它们的大小:整数variables可以保存在-32,768和32,767之间的值,而长variables可以在-2,147,483,648到2,147,483,647之间。
但是你使用哪个版本? 因为:
传统上,VBA程序员使用整数来保存less量的数据,因为它们需要更less的内存。 然而,在最近的版本中, 即使它们声明为Integertypes , VBA也会将所有整数值转换为Longtypes。 因此,使用Integervariables不再具有性能优势; 实际上,Longvariables可能会稍微快一些,因为VBA不需要转换它们。
此信息直接来自MSDN
UPDATE
也请阅读第一条评论! 我错误地解释了MSDN信息!
多数民众赞成在误导:VBA本身并不把整数转换为长。 在封面下,CPU将整数转换为长整数,然后将算术结果转换为整数。 所以VBA整数仍然不能超过32K – 查尔斯·威廉姆斯
您可以通过使用For Each而不是增加行来避免“整数与长整数”问题。 对于每个通常更快,正如避免select范围。 这是一个例子:
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