1秒延遲持續差不多2秒

Question

我正在編寫一個代碼，用於在每秒鐘將數據從一個電子表格複製到另一個電子表格。我已經嘗試了Application.Wait和Sleep，但他們阻止了這兩個電子表格，所以我決定使用do until循環。它有效，但1秒持續近2秒，我不知道爲什麼。所以我只留下了代碼中的循環，但測試給出了相同的結果（大約需要95秒）。任何建議？下面是代碼：

Sub Test() 

    Dim Delay As Date 

    cell = 1 

    For i = 1 to 60 

    Workbooks("Data").Worksheets("Sheet1").Range("C" & cell).Value = cell 

    cell = cell +1 
    Delay = Now() + TimeValue("00:00:01") 

    Do Until Now() >= Delay 

     Do Events 

    Loop 

    Next i 

    End Sub 

Answer 1

這只是一個大約的延遲，因爲你真的沒有別的什麼事情通過消息隊列和由DoEvents命令（一個字的BTW）處理的想法。另一種方法是從Application.OnTime method內部調用本程序。

Sub timed_routine() 
    Application.Interactive = False 
    ThisWorkbook.Worksheets("Sheet1").Cells(1, 1) = 1 
    Application.Interactive = True 
    'Debug.Print Timer 
    Application.OnTime Now + TimeSerial(0, 0, 1), "timed_routine" 
End Sub 

隨着Debug.Print Timer命令取消註釋和活性，這例程循環在約1.015秒。