VBA UDF 函数导致 excel 到 "not respond"

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

如果有机会'walking over'午夜，不要只依赖时间；在您的开始和结束日期时间中包含日期。

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 Function 直到时间满足是更好的方法。

VBA UDF 函数导致 excel 到 "not respond"

VBA UDF function causes excel to "not respond"

excel

vba

udf