Wie kann in Excel vba eine Zeitverzögerung von weniger als einer Sekunde angegeben werden?

Sie können einen API-Aufruf und einen Ruhezustand verwenden:

Setzen Sie dies oben in Ihr Modul:

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Dann können Sie es in einer Prozedur wie folgt aufrufen:

Sub test()
Dim i As Long

For i = 1 To 10
    Debug.Print Now()
    Sleep 500    'wait 0.5 seconds
Next i
End Sub

Ich fand das auf einer anderen Seite nicht sicher, ob es funktioniert oder nicht.

Application.Wait Now + 1/(24*60*60.0*2)

der numerische Wert 1 = 1 Tag

1/24 ist eine Stunde

1/(24 * 60) ist eine Minute

1/(24 * 60 * 60 * 2) ist also 1/2 Sekunde

Sie müssen irgendwo ein Dezimalzeichen verwenden, um eine Fließkommazahl zu erzwingen

Quelle

Nicht sicher, ob dies für Millisekunden einen Versuch wert ist

Application.Wait (Now + 0.000001) 

callforfor (.005) aufrufen 

Sub WaitFor(NumOfSeconds As Single)
    Dim SngSec as Single
    SngSec=Timer + NumOfSeconds

    Do while timer < sngsec
        DoEvents
   Loop
End sub

source Timing-Verzögerungen in VBA

Ich habe es probiert und es funktioniert für mich:

Private Sub DelayMs(ms As Long)
    Debug.Print TimeValue(Now)
    Application.Wait (Now + (ms * 0.00000001))
    Debug.Print TimeValue(Now)
End Sub

Private Sub test()
    Call DelayMs (2000)  'test code with delay of 2 seconds, see debug window
End Sub

Offensichtlich ein alter Beitrag, aber das scheint für mich zu funktionieren ....

Application.Wait (Now + TimeValue("0:00:01") / 1000)

Teilen Sie durch was auch immer Sie brauchen. Ein Zehntel, ein Hundertstel usw. scheinen alle zu funktionieren. Durch das Entfernen des "Teilen durch" -Anteils dauert es länger, bis das Makro ausgeführt wird. Daher muss ich glauben, dass es funktioniert.

Ansonsten können Sie eine eigene Funktion erstellen und dann aufrufen. Es ist wichtig, Double zu verwenden

Function sov(sekunder As Double) As Double

starting_time = Timer

Do
DoEvents
Loop Until (Timer - starting_time) >= sekunder

End Function

Keine Antwort hat mir geholfen, also baue ich das auf.

'   function Timestamp return current time in milliseconds.
'   compatible with JSON or JavaScript Date objects.

Public Function Timestamp () As Currency
    timestamp = (Round(Now(), 0) * 24 * 60 * 60 + Timer()) * 1000
End Function

'   function Sleep let system execute other programs while the milliseconds are not elapsed.

Public Function Sleep(milliseconds As Currency)

    If milliseconds < 0 Then Exit Function

    Dim start As Currency
    start = Timestamp ()

    While (Timestamp () < milliseconds + start)
        DoEvents
    Wend
End Function

Hinweis: In Excel 2007 senden Sie Now() Double mit Dezimalstellen in Sekunden. Daher verwende ich Timer(), um Millisekunden zu erhalten.

Hinweis: Application.Wait() akzeptiert Sekunden und nicht unter (d. H. Application.Wait(Now()) ↔ Application.Wait(Now()+100*millisecond)))

Hinweis: Application.Wait() lässt das System kein anderes Programm ausführen, beeinträchtigt jedoch die Leistung kaum. Bevorzugen Sie die Verwendung von DoEvents.

Public Function CheckWholeNumber(Number As Double) As Boolean
    If Number - Fix(Number) = 0 Then
        CheckWholeNumber = True
    End If
End Function

Public Sub TimeDelay(Days As Double, Hours As Double, Minutes As Double, Seconds As Double)
    If CheckWholeNumber(Days) = False Then
        Hours = Hours + (Days - Fix(Days)) * 24
        Days = Fix(Days)
    End If
    If CheckWholeNumber(Hours) = False Then
        Minutes = Minutes + (Hours - Fix(Hours)) * 60
        Hours = Fix(Hours)
    End If
    If CheckWholeNumber(Minutes) = False Then
        Seconds = Seconds + (Minutes - Fix(Minutes)) * 60
        Minutes = Fix(Minutes)
    End If
    If Seconds >= 60 Then
        Seconds = Seconds - 60
        Minutes = Minutes + 1
    End If
    If Minutes >= 60 Then
        Minutes = Minutes - 60
        Hours = Hours + 1
    End If
    If Hours >= 24 Then
        Hours = Hours - 24
        Days = Days + 1
    End If
    Application.Wait _
    ( _
        Now + _
        TimeSerial(Hours + Days * 24, Minutes, 0) + _
        Seconds * TimeSerial(0, 0, 1) _
    )
End Sub

beispiel:

call TimeDelay(1.9,23.9,59.9,59.9999999)

hoffentlich genießt du.

bearbeiten:

hier ist eine ohne zusätzliche Funktionen, für Leute, die es gerne schneller haben

Public Sub WaitTime(Days As Double, Hours As Double, Minutes As Double, Seconds As Double)
    If Days - Fix(Days) > 0 Then
        Hours = Hours + (Days - Fix(Days)) * 24
        Days = Fix(Days)
    End If
    If Hours - Fix(Hours) > 0 Then
        Minutes = Minutes + (Hours - Fix(Hours)) * 60
        Hours = Fix(Hours)
    End If
    If Minutes - Fix(Minutes) > 0 Then
        Seconds = Seconds + (Minutes - Fix(Minutes)) * 60
        Minutes = Fix(Minutes)
    End If
    If Seconds >= 60 Then
        Seconds = Seconds - 60
        Minutes = Minutes + 1
    End If
    If Minutes >= 60 Then
        Minutes = Minutes - 60
        Hours = Hours + 1
    End If
    If Hours >= 24 Then
        Hours = Hours - 24
        Days = Days + 1
    End If
    Application.Wait _
    ( _
        Now + _
        TimeSerial(Hours + Days * 24, Minutes, 0) + _
        Seconds * TimeSerial(0, 0, 1) _
    )
End Sub

Um eine Pause von 0,8 Sekunden zu machen:

Sub main()
    startTime = Timer
    Do
    Loop Until Timer - startTime >= 0.8
End Sub