Excel VBA do while 循环正在扼杀性能

Question

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

我想在打开工作表时启动 Sub，所以我添加了一个 Workbook_Open() Sub

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”。

然后将此代码放入模块（不是 Workbook 或 Worksheet 对象）中：

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 object 中的代码：

Option Explicit

Private Sub Workbook_Open()
    CellBlink
End Sub

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