VBA UDF 函數導致excel“不響應”

Question

我有一些非常簡單的代碼導致 Excel 崩潰。

我已經調試了代碼中的變量，它們看起來很好，只是在幾秒鍾之后 Now() 沒有改變並且 waitTime 沒有改變 - 盡管時間彼此不同，即時間沒有向前移動（例如，Now 可能卡在 3:00:05，waitTime 卡在 3:00:09）。

而且 application.wait 不會等待我要求的 5 秒。

並且單元格字體顏色也不會改變。

我不知道如何進一步調試。

在工作表“sheet1”中，我有以下單元格條目 - 在 C8 中，我有一個我手動更改的數字。 在 D8 我有

=if(C8>25,"yup",startFlash(C8))

這工作正常。 它調用函數沒有問題。 這是宏代碼：

Dim waitTime As Date, stopTime As Date


Function startFlash(x As String)
    Beep
    stopTime = TimeSerial(Hour(Now()), Minute(Now()) + 2, Second(Now()))
    Call sflash
    MsgBox "done"  
End Function

Sub sflash()

    Do While waitTime <= stopTime

        With Sheet1.Range("c8").Font
            If .ColorIndex = 3 Then
              .ColorIndex = 5
             Else
             .ColorIndex = 3
            End If
        End With

        newHour = Hour(Now())
        newMinute = Minute(Now())
        newSecond = Second(Now()) + 5
        waitTime = TimeSerial(newHour, newMinute, newSecond)

        Debug.Print Now(); waitTime; stopTime

        Application.Wait waitTime
    Loop

End Sub

關於更改什么代碼以阻止 Excel 崩潰的任何建議？

Answer 1

如果有機會“走過”午夜，不要獨自依賴時間； 在開始和停止日期時間中包含日期。

Option Explicit

Dim waitTime As Date, stopTime As Date

Function startFlash(x As String)
    Beep
    stopTime = Now + TimeSerial(0, 2, 0)
    'Debug.Print stopTime
    Call sflash
    MsgBox "done"
End Function

Sub sflash()

    Do While waitTime <= stopTime

        With Sheet1.Range("c8").Font
            If .ColorIndex = 3 Then
              .ColorIndex = 5
             Else
             .ColorIndex = 3
            End If
        End With

        waitTime = Now + TimeSerial(0, 0, 5)
        'Debug.Print Now; waitTime; stopTime

        Do While Now < waitTime: DoEvents: Loop
    Loop

End Sub

循環DoEvents 函數直到時間滿足是更好的方法。