Do While循环每秒闪烁一次单元格是扼杀性能的

Question

我写了一个宏来检查日期是否是一个月的最后一天
如果是这样的话，这个单元格应该每1秒闪烁一次，所以我调用了Do While循环。

我想在打开工作表时启动Sub，所以我添加了一个Sub Workbook_Open()。如果日期是一个月的最后一天，则会按预期调用此子项。

Private Sub Workbook_Open()
Call CellBlink
End Sub

性能太差了，几乎不可能使用这张纸。

Do While Today = EndOfMonth
CellThatBlinks.Interior.ColorIndex = 3
Application.Wait (Now + TimeValue("0:00:01"))
CellThatBlinks.Interior.ColorIndex = 0
Application.Wait (Now + TimeValue("0:00:01"))
CellThatBlinks.Interior.ColorIndex = 3
DoEvents
Loop

Answer 1

使用Application.OnTime是一种循环而不阻塞执行的方法。

首先Name工作簿中要闪烁的单元格，例如"；BlinkCell"；，使用公式/定义名称。

然后将此代码放入模块(而不是工作簿或工作表对象(：

Option Explicit
Dim strLast As String
Public Sub CellBlink()
Dim rngBlink As Range

If WorksheetFunction.EoMonth(Now, 0) = Int(Now) Then
Set rngBlink = Range("BlinkCell")

Dim onIndex, offIndex
onIndex = 3
offIndex = 0

If rngBlink.Interior.ColorIndex = onIndex Then
rngBlink.Interior.ColorIndex = offIndex
Else
rngBlink.Interior.ColorIndex = onIndex
End If

strLast = Format(Now + TimeValue("00:00:01"), "hh:mm:ss")
Application.OnTime strLast, "CellBlink"
End If
End Sub
Public Sub CancelBlink()
If Len(strLast) > 0 Then
Application.OnTime strLast, "CellBlink", Schedule:=False
Range("BlinkCell").Interior.ColorIndex = 0
End If
End Sub

ThisWorkbook对象中的代码：

Option Explicit
Private Sub Workbook_Open()
CellBlink
End Sub
Private Sub Workbook_BeforeClose(Cancel as Boolean) 
CancelBlink
End Sub

工作原理：一旦触发Workbook_Open事件，就会调用全局子例程CellBlink。在表格中，闪烁的单元格是Name'd"；BlinkCell"；。CellBlink检查今天的日期是否是月底：如果是，则切换单元格颜色(打开-关闭-打开等(。最后，调用Application.OnTime函数以在一秒钟内运行相同的CellBlink宏。宏计划运行的时间将保存为字符串。运行CancelBlink宏将终止循环，直到再次调用CellBlink为止。