VBA UDF-Funktion verursacht Excel zu "nicht reagieren"

Question

Ich habe einige sehr einfachen Code, der Excel zum Absturz bringt.

Ich habe die Variablen wie im Code zu sehen debugged und sie sehen gut aus, außer dass nach nur ein paar Sekunden Now() ändert sich nicht und waitTime ändert sich nicht - obwohl die Zeiten unterscheiden sich voneinander, dh die Zeit hat sich nicht vorwärts bewegt (zum Beispiel könnte Now um 3:00:05 stecken bleiben und waitTime ist um 3:00:09 fest).

Und application.wait wartet nicht die 5 Sekunden, die ich gefragt habe.

Und die Zellenschriftfarbe ändert sich auch nicht.

Ich weiß nicht weiter zu debuggen.

Im Arbeitsblatt "sheet1" habe ich die folgenden Zelleneinträge - in C8 Ich habe eine Nummer, die ich manuell ändere. In D8 habe ich

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

Und das funktioniert gut. Es ruft die Funktion ohne Probleme auf. Hier ist der Makro-Code:

Alle Vorschläge, welchen Code zu ändern, um Excel vor Absturz zu stoppen?

Answer 1

Verlassen Sie sich nicht auf die Zeit allein, wenn es eine Chance gibt, zu Mitternacht zu "gehen"; Geben Sie das Datum in den Start- und Enddatum ein.

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 

der DoEvents Function Looping durch, bis die Zeiten erfüllen, ist eine bessere Methode.