web-dev-qa-db-de.com

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

ich möchte ein Ereignis nach einer bestimmten Dauer von weniger als 1 Sekunde wiederholen. Ich habe versucht, den folgenden Code zu verwenden

Application.wait Now + TimeValue ("00:00:01")

Die minimale Verzögerungszeit beträgt hier jedoch eine Sekunde. Wie kann man eine halbe Sekunde warten?

25
Rito

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
20
Doug Glancy

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) 
14
graham nelson

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

11
user4232305

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
4
Nam

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.

0
RollTideMike

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
0
VilhelmP

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.

0
karkael
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
0
matan justme

Um eine Pause von 0,8 Sekunden zu machen:

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