执行 VBA 代码使 Excel 无响应然后恢复

Question

此代码搜索以查看 A 列中的哪些条目未出现在 B 列中。然后将此 A 列条目及其相邻的 B 列和 C 列条目写入 F、G、H 列.

执行到迭代350/83118后卡住，大约20分钟后恢复，迭代完成。如您所见，计算模式设置为手动，我尝试关闭屏幕更新，显示分页符和事件，但它仍然冻结。

有什么办法可以阻止它冻结吗？我不介意执行代码需要更长的时间，因为它不会冻结并让用户放心迭代计数稳步增加。

Sub MacroToCreateReducedBoMList()


Dim LR As Long, i As Long, j As Long
Dim LastRow As Long
Dim StartCell As Range
Dim Calc_Setting As Long
Dim StartTime As Double
Dim MinutesElapsed As String


StartTime = Timer
Calc_Setting = Application.Calculation
Application.Calculation = xlCalculationManual

'Turning off events temporarily'
Dim EventState As Boolean
EventState = Application.EnableEvents
Application.EnableEvents = False

'Turning off page breaks temporarily'
Dim PageBreakState As Boolean
PageBreakState = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False


Set StartCell = Range("A1")
'Find Last Row'
LastRow = StartCell.SpecialCells(xlCellTypeLastCell).Row

j = 2

Application.ScreenUpdating = False

Range("F2:H130000").ClearContents

'MAIN CODE'
For i = 2 To LastRow
If WorksheetFunction.CountIf(Range("B:B"), Range("A" & i)) = 0 Then
    Debug.Print Range("A" & i)
    Cells(j, 6) = Range("A" & i)
    Cells(j, 7) = Range("B" & i)
    Cells(j, 8) = Range("C" & i)
    j = j + 1
End If

'Message to user about current iteration'
Application.StatusBar = "Current iteration: " & i & "/" & LastRow & ".  
Please be patient, code takes roughly 20 minutes to execute, go get a coffee."

Next i

Application.ScreenUpdating = True
Application.Calculation = Calc_Setting

'Turning events back on'
Application.EnableEvents = EventState

'Turning page breaks back on'
ActiveSheet.DisplayPageBreaks = PageBreakState

'Determine how many seconds code took to run
 MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

'Notify user in minutes
MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", vbInformation

End Sub

Answer 1

你应该在更新消息后将 Application.ScreenUpdating = true 放入 for 循环中并放入 false:

'Message to user about current iteration'
Application.ScreenUpdating = true
Application.StatusBar = "Current iteration: " & i & "/" & LastRow & _  
    "Please be patient, code takes roughly 20 minutes to execute, go get a coffee."
Application.ScreenUpdating = false

此外，worksheetFunction.CountIf 可能会触发手动重新计算 sheet。

Answer 2

如果 Excel 花费太长时间运行一个宏，然后 Windows 将假定它不再响应，并冻结屏幕。您可以使用 DoEvents 来缓解这种情况，这将使 Excel 变为 "check in" Windows.

但是，由于这个做 "check in" 和做事件，它也是一个相对较慢的函数 - 所以不要在循环的每次迭代中都调用它。例如，下面的代码行将运行它的间隔为 300 行：

If (i mod 300) = 0 Then DoEvents

您还可以打开屏幕更新，强制进行屏幕更新，然后关闭屏幕更新以进行视觉更新。添加那个给你这个：

If (i mod 300) = 0 Then
    Application.ScreenUpdating = True
    Application.WindowState = Application.WindowState 'Force Screen Update
    Application.ScreenUpdating = False
    DoEvents 'Check in with Windows
End If

执行 VBA 代码使 Excel 无响应然后恢复

Executing VBA code makes Excel non responsive then recovers

excel

vba

freeze