Question

我想在一段不到1秒的时间后重复一个事件。我尝试使用以下代码

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

但这里的最短延迟时间是一秒钟。如何延迟说半个月？

Answer 1

您可以使用API调用和睡眠：

将它放在模块的顶部：

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

Answer 2

我在另一个网站上发现了这个，不确定它是否有效。

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

数值1 = 1天

1/24是一小时

1 /（24 * 60）是一分钟

所以1 /（24 * 60 * 60 * 2）是1/2秒

您需要在某处使用小数点来强制浮点数

Source

不确定这是否适用于毫秒的拍摄

Application.Wait (Now + 0.000001)

Answer 3

call waitfor（.005）

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

    Do while timer < sngsec
        DoEvents
   Loop
End sub

源 Timing Delays in VBA

Answer 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

Answer 5

显然是一个老帖子，但这似乎对我有用....

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

除以你需要的任何东西。一切都是十分之一，一百分之一等。通过删除“除以”部分，宏确实需要更长的时间来运行，因此，在没有错误的情况下，我必须相信它有效。

Answer 6

否则你可以创建自己的函数然后调用它。使用Double

非常重要

Function sov(sekunder As Double) As Double

starting_time = Timer

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

End Function

Answer 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。

Answer 8

每个人都尝试Application.Wait，但这并不是真的可靠。如果您要求它等待不到一秒钟，您将得到0到1之间的任何值，但接近10秒。这是一个等待0.5秒的演示：

Sub TestWait()
  Dim i As Long
  For i = 1 To 5
    Dim t As Double
    t = Timer
    Application.Wait Now + TimeValue("0:00:00") / 2
    Debug.Print Timer - t
  Next
End Sub

以下是输出，平均为0.0015625秒：

诚然，Timer可能不是衡量这些事件的理想方法，但是您明白了。

Timer方法更好：

Sub TestTimer()
  Dim i As Long
  For i = 1 To 5
    Dim t As Double
    t = Timer
    Do Until Timer - t >= 0.5
      DoEvents
    Loop
    Debug.Print Timer - t
  Next
End Sub

平均结果非常接近0.5秒：

0.5
0.5
0.5
0.5
0.5

Answer 9

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

Answer 10

要暂停0.8秒：

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

如何在excel vba中给出不到一秒的时间延迟？

10 个答案: