Làm thế nào để cung cấp cho một sự chậm trễ thời gian ít hơn một giây trong vba excel?

Question

tôi muốn lặp lại một sự kiện sau một khoảng thời gian nhất định dưới 1 giây. Tôi đã thử sử dụng mã sau đây

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

Nhưng ở đây thời gian trễ tối thiểu là một giây. Làm thế nào để cho một sự chậm trễ của nói một nửa seond?

Answer 1

Tôi thấy điều này trên một trang web khác không chắc liệu trang web có hoạt động hay không.

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

giá trị bằng số 1 = 1 ngày

1/24 là một giờ

1/(24 * 60) là một phút

quá 1/(24 * 60 * 60 * 2) là 1/2 giây

Bạn cần sử dụng dấu thập phân ở đâu đó để buộc số dấu phẩy động

Source

Không chắc chắn nếu điều này sẽ làm việc đáng ghi bàn dẫn trước mili giây

Application.Wait (Now + 0.000001) 

Answer 2

Bạn có thể sử dụng một cuộc gọi API và Ngủ:

Đặt này ở phía trên cùng của mô-đun của bạn:

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 

Sau đó, bạn có thể gọi trong quy trình như sau:

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 3

Tôi có cố gắng này và nó làm việc cho tôi:

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 4

gọi waitfor (.005)

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

    Do while timer < sngsec 
     DoEvents 
    Loop 
End sub 

nguồn Timing Delays in VBA

Answer 5

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 

dụ:

call TimeDelay(1.9,23.9,59.9,59.9999999) 

hopy bạn thích.

chỉnh sửa:

đây là một mà không có bất kỳ chức năng bổ sung, đối với những người thích nó là nhanh hơn

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 6

Nếu không, bạn có thể tạo chức năng riêng của bạn sau đó gọi nó, quan trọng là phải sử dụng hai

Function sov(sekunder As Double) As Double 

starting_time = Timer 

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

End Function 

Answer 7

Rõ ràng là một bài đăng cũ, nhưng điều này dường như đang làm việc cho tôi ....

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

Chia theo bất kỳ thứ gì bạn cần. Một phần mười, một trăm, vv tất cả dường như làm việc. Bằng cách loại bỏ phần "chia cho", macro sẽ mất nhiều thời gian hơn để chạy, do đó, không có lỗi, tôi phải tin rằng nó hoạt động.

Answer 8

Không có câu trả lời nào giúp tôi, vì vậy tôi đã xây dựng nó.

' 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 

Lưu ý: Trong Excel 2007, Now() gửi đôi với số thập phân đến giây, vì vậy tôi sử dụng để có được Timer() mili giây.

Lưu ý:Application.Wait() chấp nhận giây và không dưới (ví dụ: Application.Wait(Now()) ↔ Application.Wait(Now()+100*millisecond)))

Lưu ý:Application.Wait() không cho phép hệ thống thực hiện chương trình khác nhưng hầu như không làm giảm hiệu suất. Ưu tiên sử dụng DoEvents.