如何在excel vba中提供小于1秒的时间延迟？

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

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

---

但这里的最小延迟时间是1秒。如何延迟半个月呢？

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

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) 

---

您可以使用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

---

我尝试过这个，它对我很有效：

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

调用waitfor（.005）

Sub WaitFor（以秒为单位）
Dim SngSec作为单个
SngSec=计时器+纳秒
定时器

来源

例如：

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

---

否则，您可以创建自己的函数，然后调用它。重要的是要使用双精度

Function sov(sekunder As Double) As Double

starting_time = Timer

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

End Function

---

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

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

---

除以你所需要的。十分之一、百分之一等似乎都起作用。通过删除“除以”部分，宏确实需要更长的时间才能运行，因此，如果没有出现错误，我必须相信它是有效的。

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

'   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

'函数时间戳返回当前时间（毫秒）。
'与JSON或JavaScript日期对象兼容。
作为货币的公共函数Timestamp（）
时间戳=（四舍五入（现在（），0）*24*60*60+计时器（））*1000
端函数
'功能睡眠允许系统在未超过毫秒的情况下执行其他程序。
公共函数睡眠（毫秒作为货币）
如果毫秒<0，则退出函数
作为货币开始
开始=时间戳（）
While（时间戳（）<毫秒+开始）
多芬特
温德
端函数

注意：在Excel2007中，

Now（）

发送双精度小数到秒，因此我使用

Timer（）

来获取毫秒

注意：

Application.Wait（）

接受秒和不在下（即

Application.Wait（Now（））

↔ <代码>应用程序。等待（现在（）+100*毫秒）））

---

注意：

应用程序.Wait（）

不允许系统执行其他程序，但几乎不会降低性能。首选使用

DoEvents

暂停0.8秒：

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

---

每个人都在尝试应用程序。等等，但这并不可靠。如果您让它等待不到一秒钟，您将得到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
0
0
0.0078125
0

0.5
0.5
0.5
0.5
0.5

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

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

0.5
0.5
0.5
0.5
0.5

诚然，计时器可能不是测量这些事件的理想方法，但你明白了

计时器方法更好：

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秒：

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

0.5
0.5
0.5
0.5
0.5

---

如果代码在64位操作系统中，则需要使用

PtrSafe

查看您的半秒示例是否正确，但毫秒示例不正确。一毫秒=一天的1/（1000*24*60*60），等于一天的0.000000011574。要将代码中的毫秒作为常数：

Const ms as Double=0.0000000 11574

例如，要等待四分之一秒，

Application.wait Now+ms*250

对于初始问题“如何在excel VBA中提供小于1秒的时间延迟”，此答案是错误的。延迟小于1000毫秒时，此功能不起作用！您可以通过尝试以下代码片段来检查它：

Dim lngIdx作为lngIdx=0到5000“newline”应用程序的长“newline”。等待（现在+（100*0.00000001））“newline”下一个lngIdx“newline”

如果您等待的时间小于1秒，VBA将等待0到1秒之间的任何时间，通常接近于零。我对Application.Wait Now+TimeValue（“0:00:00”）/2（半秒）进行了快速测试，平均等待时间为0.00156秒。