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 。