我的应用程序已经运行了几个月。今天突然需要7秒才能执行application.screenupdating = True。
之前有没有人观察到这种奇怪的行为,如果有,请指出我正确的方向?我花了很多时间试图找出造成这种情况并进行研究的内容,但无济于事。
问题只发生在应用程序跨列扫描并根据需要自动隐藏和取消隐藏列之后。结论它调用Sub SettingsOn,它只有以下内容:
Sub SettingsOn ()
With Application
.EnableEvents = True
.ScreenUpdating = True ' this is the problem command
.DisplayAlerts = True
End With
End Sub
我也试过切换序列而没有效果。
这是之前和之后的debug.print输出:
完成色谱柱操作后,延迟始终为7到8秒左右。在所有其他时间它立即执行。正如我先前所说的那样,直到现在它才成为一个问题,它始终是即时的。
很奇怪,以前我没见过这样的事。
答案 0 :(得分:1)
我不相信ScreenUpdating = True
是罪魁祸首。
EnableEvents
更有可能造成超过一秒的延迟。你在使用哪些活动?
要确认您的诊断,请暂时将
SettingsOn
程序替换为下面的程序,然后像以前一样运行您的应用程序,从立即窗口复制结果,然后edit您的问题发布结果。 (如果代码停止时立即窗口未显示结果,请按 Ctrl + G ):
Sub SettingsOn()
Dim startTime As Single
With Application
startTime = Timer: .EnableEvents = True
Debug.Print vbLf & vbLf & "EnableEvents = " & Format(Timer - startTime, "0.000 sec")
startTime = Timer: .ScreenUpdating = True
Debug.Print "ScreenUpdating = " & Format(Timer - startTime, "0.000 sec")
startTime = Timer: .DisplayAlerts = True
Debug.Print "DisplayAlerts = " & Format(Timer - startTime, "0.000 sec") & vbLf
MsgBox "After clicking OK, hit CTRL+G to open immediate window, then Copy the last 3 lines."
Stop
End With
End Sub
如果重新启用EnableEvents
时出现排队事件,可能需要一些时间才能赶上。
另一个可能的影响因素是内存使用。如果内存泄漏之类的编码错误是(或存在),那么这可能会大大减慢事情,以及其他不可预测的行为。你最近重启了吗?您是否正在处理任何可能正确获得.Close
的对象?
看似无关紧要的错误可能会导致ScreenUpdating
或EnableEvents
行为不同。
如果在测试程序开始时添加.Repaint
,结果会更改吗?
是什么促使你注意到7秒的延迟? ie。多久你禁用&重新启用?
通过设置Application.Calculation = xlCalculationManual
(以及之后返回xlCalculationAutomatic)禁用自动计算
使用Application.DisplayStatusBar = False
Excel必须重新计算每个工作表更改的分页符,除非它已被Activesheet.DisplayPageBreaks = False
防止数据透视表更新:ActiveSheet.PivotTables(“PivotTable1”).ManualUpdate = True
如果您的代码是copy-and-pastng单元格,那么如果时间(包括重新计算)需要相当多的时间,特别是如果您使用的代码如下:
范围(" A1&#34)。选择 Selection.Copy 范围(" A2&#34)。选择 ActiveSheet.Paste
通过跳过剪贴板加快速度:(显然快25倍)
范围(" A1")。复制目的地:=范围(" A2")
更多提示here。
此功能可用于检查代码执行期间的内存使用 :(Source)
Function GetMemUsage()
' Returns the current Excel.Application Working Memory usage in KB
Dim objSWbemServices: Set objSWbemServices = GetObject("winmgmts:")
GetMemUsage = objSWbemServices.Get("Win32_Process.Handle='" & GetCurrentProcessId & "'").WorkingSetSize / 1024
Set objSWbemServices = Nothing
End Function
还可以通过替换WorkingSetSize
来验证许多其他指标。完整列表here。