[已解决]征集让vba暂停零点几秒的方法

happym8888

Timer 函数示例

本示例使用 Timer 函数来暂停应用程序。同时用 DoEvents 在暂停期间将控制让给其他进程。

Dim PauseTime, Start, Finish, TotalTimeIf (MsgBox("Press Yes to pause for 5 seconds", 4)) = vbYes Then    PauseTime = 5    ' 设置暂停时间。    Start = Timer    ' 设置开始暂停的时刻。    Do While Timer < Start + PauseTime        DoEvents    ' 将控制让给其他程序。    Loop    Finish = Timer    ' 设置结束时刻。    TotalTime = Finish - Start    ' 计算总时间。    MsgBox "Paused for " & TotalTime & " seconds"Else    EndEnd If 注：03版Excel帮助文件里有。

爱疯

很不错的贴，学习了！
我发现，按同样方法来比较，4楼办法好像是有问题

1. 
   
2. Sub main()
   
3.     Dim t
   
4.     Debug.Print
   
5.     Debug.Print Timer
   
6.     '每次只启用一个call
   
7.     Call delay          '2楼
   
8.     Call PauseHalfSec   '3楼
   
9.     Call aa             '4楼
   
10.     Debug.Print Timer
    
11. End Sub
    
12. 
    
13. Sub delay()
    
14.     Dim t
    
15.     t = Timer
    
16.     Do While Timer - 0.5 < t
    
17.     Loop
    
18. End Sub
    
19. 
    
20. Sub PauseHalfSec()
    
21.     Dim S
    
22.     S = Timer
    
23.     Do
    
24.     Loop Until Timer - S >= 0.5
    
25. End Sub
    
26. 
    
27. Sub aa()
    
28.     Application.Wait (Now + TimeValue("0:00:05") / 10)
    
29. End Sub

复制代码

Tristone

学习了，以后用到可以来这里回顾了

leolee82

sleep是最直接最简单的
如果每0.几秒运行一次的话可以考虑用settimer

吕?布

借用爱疯的代码做了个测试

结论：500毫秒时delay，PauseHalfSec与DelayEx差不多，aa根本不能做1秒以延时
征集让vba暂停零点几秒的方法.rar (9.68 KB, 下载次数: 14)

2012-2-9 17:38 上传

点击文件名下载附件

Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long

Sub main()
    Dim t, ms As Long
    Debug.Print
    ms = 500    '单位是毫秒
    Debug.Print Timer
    '每次只启用一个call
    Application.Calculate
    Call delay(ms, 1, 2)        '2楼
    Call PauseHalfSec(ms, 4, 5) '3楼
    Call aa(ms, 7, 8)           '4楼
    Call DelayEx(ms, 10, 11)
    Debug.Print Timer
End Sub

Sub delay(ms As Long, x As Long, y As Long)
    Dim t As Double
    Dim dl As Double
    dl = ms / 1000
    Cells(x, 1) = Cells(1, 2).Value

    t = Timer
    Do While Timer - dl < t
    Loop

    Application.Calculate
    Cells(y, 1) = Cells(1, 2).Value
End Sub

Sub PauseHalfSec(ms As Long, x As Long, y As Long)
    Dim S As Double
    Dim dl As Double
    dl = ms / 1000
    Cells(x, 1) = Cells(1, 2).Value

    S = Timer
    Do
    Loop Until Timer - S >= dl
   
    Application.Calculate
    Cells(y, 1) = Cells(1, 2).Value
End Sub

Sub aa(ms As Long, x As Long, y As Long)
    Dim dl As Double
    dl = ms / 1000
    Cells(x, 1) = Cells(1, 2).Value
   
    'Application.Wait (Now + TimeValue("0:00:05") / 10)
    Application.Wait (Now + ms / 1000 / 24 / 60 / 60)
   
    Application.Calculate
    Cells(y, 1) = Cells(1, 2).Value

End Sub

Private Function DelayEx(ms As Long, x As Long, y As Long)       'ms是延时的时长，单位是毫秒
    Dim start As Long
    Cells(x, 1) = Cells(1, 2).Value

    start = GetTickCount
    Do While GetTickCount - start < ms
    Loop
   
    Application.Calculate
    Cells(y, 1) = Cells(1, 2).Value
End Function

exc姜

好方法