VBA脚本导致Excel在15次循环后无响应

Question

我正在运行一个脚本来查找和删除包含2018年后的数据的行.我正在搜索大约650000行.每次我在5秒后运行脚本时,我的光标变为旋转圆圈,excel程序变得无响应.这是我正在使用的代码.

Option Explicit
Option Base 1 'row and column index will match array index

Sub removeWrongYear()

Dim i As Long, yearA As Long, rowsCnt As Long
Dim rowsToDelete As Range
Dim vData As Variant

With ActiveSheet

    '1st to 635475 row, 20th column
    vData = Range(.Cells(1, 20), .Cells(635475, 20))

    For i = UBound(vData) To 2 Step -1
       If Val(Right(vData(i,1),2)) > 17 Then
        Debug.Print Val(Right(vData(i,1),2))
            rowsCnt = rowsCnt + 1

            If rowsCnt > 1 Then
                Set rowsToDelete = Union(rowsToDelete, .Rows(i))
            ElseIf rowsCnt = 1 Then
                Set rowsToDelete = .Rows(i)
            End If

        End If
    Next i

End With

If rowsCnt > 0 Then
    Application.ScreenUpdating = False
    rowsToDelete.EntireRow.Delete
    Application.ScreenUpdating = True
End If

End Sub

Answer 1

每次我在5秒后运行脚本时,我的光标变为旋转圆圈,excel程序变得无响应.

这很正常.VBA在单个可用的UI线程上运行,同一个Excel运行.当它忙于运行你的循环时,它无法响应其他刺激,并告诉你通过在标题栏中加上"(不响应)",直到它完成工作并且能够恢复做它需要做的所有其他事情(即收听鼠标和键盘消息等).

您可以DoEvents在该循环的主体中添加一点,以允许Excel在迭代之间呼吸和处理挂起的消息,但是有一个问题:首先,您的代码将花费更长的时间来完成,其次,如果用户能够选择/在该循环中间激活另一个工作表,然后这个不合格的Range调用:

vData = Range(.Cells(1, 20), .Cells(635475, 20))

...将是运行时错误1004的来源,因为你无法做到Sheet1.Range(Sheet2.Cells(1,20), Sheet2.Cells(635475,20))并希望Excel知道如何处理它(假设Sheet2在循环开始时活动,并且用户Sheet1在其中间激活) .

这个答案提供了在涉及大量行时有条件地删除行的最有效方法.如果可以,添加一个帮助列来计算您的条件(例如,让它返回TRUE要保留FALSE的行和要删除的行),然后使用Worksheet.Replace和Worksheet.SpecialCells执行过滤和删除:

.Columns("Z:Z").Replace What:=False, _
                        Replacement:="", _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        MatchCase:=False, _
                        SearchFormat:=False, _
                        ReplaceFormat:=False
.Columns("Z:Z").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

然后你不需要一个循环,它可能在你计算到5秒之前完成.

除此之外,长期运行只是:长期运行.拥有它:

Application.StatusBar = "Please wait..."
Application.Cursor = xlWait
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

'..code..

Application.Cursor = xlDefault
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.StatusBar = False