Как дать задержку времени менее одной секунды в excel vba?

Ответ 1

Вы можете использовать вызов API и Sleep:

Поместите это вверху вашего модуля:

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

Затем вы можете вызвать его в следующей процедуре:

Sub test()
Dim i As Long

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

Ответ 2

Я нашел это на другом сайте, не уверен, работает ли он или нет.

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

the numerical value 1 = 1 day

1/24 - один час

1/(24 * 60) - одна минута

so 1/(24*60*60*2) is 1/2 second

Вам нужно где-то использовать десятичную точку, чтобы заставить число с плавающей запятой

Источник

Не уверен, что это будет стоить миллисекунд

Application.Wait (Now + 0.000001) 

Ответ 3

вызвать waitfor (.005)

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

    Do while timer < sngsec
        DoEvents
   Loop
End sub

Источник Задержки времени в VBA

Ответ 4

Я попробовал это, и он работает для меня:

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

Ответ 5

Очевидно, что старый пост, но это, похоже, работает для меня....

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

Разделите все, что вам нужно. Десятая, сотая и т.д. Все работают. Удаляя часть "делить на", макросу требуется больше времени для запуска, поэтому, без ошибок, я должен полагать, что он работает.

Ответ 6

В противном случае вы можете создать свою собственную функцию, а затем вызвать ее. Важно использовать Double

Function sov(sekunder As Double) As Double

starting_time = Timer

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

End Function

Ответ 7

Мне не ответили, поэтому я создал это.

'   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

Примечание.. В Excel 2007 Now() отправьте Double с десятичными знаками на секунды, поэтому я использую Timer() для получения миллисекунд.

Примечание: Application.Wait() принять секунды и не под (т.е. Application.Wait(Now()) ↔ Application.Wait(Now()+100*millisecond)))

Примечание. Application.Wait() не позволяет системе выполнять другую программу, но вряд ли снижает производительность. Предпочитайте использование DoEvents.

Ответ 8

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

Пример:

call TimeDelay(1.9,23.9,59.9,59.9999999)

надеюсь, вам понравится.

изменить:

здесь один без каких-либо дополнительных функций, для людей, которым нравится это быстрее

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

Ответ 9

Чтобы сделать паузу на 0,8 секунды:

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