vba 如何在excel vba中给出小于一秒的时间延迟？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18602979/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How to give a time delay of less than one second in excel vba?
提问by Rito
i want to repeat an event after a certain duration that is less than 1 second. I tried using the following code
我想在小于 1 秒的特定持续时间后重复一个事件。我尝试使用以下代码
Application.wait Now + TimeValue ("00:00:01")
But here the minimum delay time is one second. How to give a delay of say half a seond?
但这里的最小延迟时间是一秒。如何给延迟说半秒？
回答by Doug Glancy
You can use an API call and Sleep:
您可以使用 API 调用和睡眠：
Put this at the top of your module:
把它放在你的模块的顶部：
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Then you can call it in a procedure like this:
然后你可以在这样的过程中调用它：
Sub test()
Dim i As Long
For i = 1 To 10
Debug.Print Now()
Sleep 500 'wait 0.5 seconds
Next i
End Sub
回答by graham nelson
I found this on another site not sure if it works or not.
我在另一个网站上发现了这个，不确定它是否有效。
Application.Wait Now + 1/(24*60*60.0*2)
the numerical value 1 = 1 day
1/24 is one hour
1/(24*60) is one minute
so 1/(24*60*60*2) is 1/2 second
数值 1 = 1 天
1/24 是一小时
1/(24*60) 是一分钟
所以 1/(24*60*60*2) 是 1/2 秒
You need to use a decimal point somewhere to force a floating point number
您需要在某处使用小数点来强制浮点数
Not sure if this will work worth a shot for milliseconds
不确定这是否值得一试几毫秒
Application.Wait (Now + 0.000001)
回答by user4232305
call waitfor(.005)
呼叫等待（.005）
Sub WaitFor(NumOfSeconds As Single)
Dim SngSec as Single
SngSec=Timer + NumOfSeconds
Do while timer < sngsec
DoEvents
Loop
End sub
source Timing Delays in VBA
回答by Nam
I have try this and it works for me:
我试过这个，它对我有用：
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
回答by VilhelmP
Otherwise you can create your own function then call it. It is important to use Double
否则，您可以创建自己的函数然后调用它。使用 Double 很重要
Function sov(sekunder As Double) As Double
starting_time = Timer
Do
DoEvents
Loop Until (Timer - starting_time) >= sekunder
End Function
回答by RollTideMike
Obviously an old post, but this seems to be working for me....
显然是旧帖子，但这似乎对我有用....
Application.Wait (Now + TimeValue("0:00:01") / 1000)
Divide by whatever you need. A tenth, a hundredth, etc. all seem to work. By removing the "divide by" portion, the macro does take longer to run, so therefore, with no errors present, I have to believe it works.
除以你需要的任何东西。十分之一、百分之一等似乎都有效。通过删除“除法”部分，宏确实需要更长的时间才能运行，因此，如果没有错误，我必须相信它可以工作。
回答by karkael
No answer helped me, so I build this.
没有答案帮助我，所以我建立了这个。
' 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
Note :In Excel 2007, Now()send Double with decimals to seconds, so i use Timer()to get milliseconds.
注意：在 Excel 2007 中，Now()将带小数的 Double 发送到秒，所以我使用Timer()毫秒。
Note :Application.Wait()accept seconds and no under (i.e. Application.Wait(Now())? Application.Wait(Now()+100*millisecond)))
注意：Application.Wait()接受秒，没有下（即Application.Wait(Now())？Application.Wait(Now()+100*millisecond))）
Note :Application.Wait()doesn't let system execute other program but hardly reduce performance. Prefer usage of DoEvents.
注意：Application.Wait()不会让系统执行其他程序，但几乎不会降低性能。更喜欢使用DoEvents.
回答by Jon Peltier
Everyone tries Application.Wait, but that's not really reliable. If you ask it to wait for less than a second, you'll get anything between 0 and 1, but closer to 10 seconds. Here's a demonstration using a wait of 0.5 seconds:
每个人都尝试过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
Here's the output, an average of 0.0015625 seconds:
这是输出，平均为 0.0015625 秒：
0
0
0
0.0078125
0
Admittedly, Timer may not be the ideal way to measure these events, but you get the idea.
诚然，计时器可能不是衡量这些事件的理想方式，但您明白了。
The Timer approach is better:
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
And the results average is very close to 0.5 seconds:
结果平均值非常接近 0.5 秒：
0.5
0.5
0.5
0.5
0.5
回答by matan justme
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
example:
例子：
call TimeDelay(1.9,23.9,59.9,59.9999999)
hopy you enjoy.
希望你喜欢。
edit:
编辑：
here's one without any additional functions, for people who like it being faster
这是一个没有任何附加功能的，适合喜欢它更快的人
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
回答by user12015430
To pause for 0.8 of a second:
暂停 0.8 秒：
Sub main()
startTime = Timer
Do
Loop Until Timer - startTime >= 0.8
End Sub
