excel - 如何在excel vba中给出小于一秒的时间延迟？

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 秒

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

资源

不确定这是否值得一试几毫秒

Application.Wait (Now + 0.000001) 

Answer 3

调用 waitfor(.005)

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

    Do while timer < sngsec
        DoEvents
   Loop
End sub

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过，但这并不可靠。如果您要求它等待不到一秒，您将得到介于 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 秒：

0
0
0
0.0078125
0

诚然，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 6

否则，您可以创建自己的函数然后调用它。使用 Double 很重要

Function sov(sekunder As Double) As Double

starting_time = Timer

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

End Function

Answer 7

暂停 0.8 秒：

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

Answer 8

没有答案帮助我，所以我建立了这个。

'   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 9

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

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

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

Answer 10

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