Application.Wait 破坏了我的代码

Question

Original

我有以下代码为单元格着色以演示毫秒等待时间的使用。但是，当 i = 500 代码中断时。我得到的错误是 Code Execution has been Interrupted 并且从 500 到 1000 我必须继续点击继续。我试图将我的代码包装在 Application.DisplayAlerts = False 和 True 中，但它仍然被中断并且无法完成。我估计随着 i 接近 1000，此代码大约需要 6 分钟。我不知道是什么原因造成的。我已经完成了我能想到的所有设置，并且它不会在不中断的情况下继续超过 500。毫秒是根据 1/(1000*24*60*60).

计算得出的

Excel 2007

Sub Kaleidoscope()
Dim r, g, b, i As Integer, ms As Double

ms = 0.0000000115741
For i = 1 To 1000
    r = WorksheetFunction.RandBetween(1, 255)
    g = WorksheetFunction.RandBetween(1, 255)
    b = WorksheetFunction.RandBetween(1, 255)
    Range("A1").Interior.Color = RGB(r, g, b)
    Application.Wait (Now + (ms * i))
Next i

End Sub

提前致谢！

Update

@MarcoMarc (whosebug.com/a/5823507/5175942) 提供的 link 解决了我问题的初始中断问题。但是，它似乎仍然没有正确递增。就好像它没有等到 i = 500 然后似乎每次都停滞了 1 秒。这是您所说的限制，最终不可能等待 1 毫秒吗？无需更改原始代码即可防止中断。

Final Thoughts

@JohnMuggins 对我的原始代码进行了很大的调整，并提供了额外的工具来查看幕后的计算。不过，最终，他还必须像@MacroMarc 一样调用 winAPI 才能将代码暂停不到 1 秒。通过对其他网站和 Stack Overflow 的研究，似乎无法单独使用 VBA 将程序暂停少于 1 秒。它要么以正常速度运行，要么在达到 500 毫秒时四舍五入为 1 秒，并将代码延迟 1 秒而不是 500 毫秒。我的最终演示代码在下面带有@JohnMuggins 调整。

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

Sub Kaleidascope()
Dim StartTime As Double
Dim EndTime As Double
Dim ms As Double
Dim i, r, g, b As Integer
Dim count As Long

StartTime = Timer

For i = 1 To 500
    ms = i
    r = WorksheetFunction.RandBetween(1, 255)
    g = WorksheetFunction.RandBetween(1, 255)
    b = WorksheetFunction.RandBetween(1, 255)
    Range("A1").Interior.Color = RGB(r, g, b)
    Sleep ms
    Range("B1").Value = "Time: " & Format(Timer - StartTime, "####.###")
    Range("C1").Value = "ms =  " & Format(ms, "####.####")
    Range("D1").Value = i & " of 500"
Next i

EndTime = Timer - StartTime
Debug.Print Format(EndTime, "####.##")
End Sub

Answer 1

0m3r 是正确的。问题出在 application.wait 函数上。请尝试以下执行事件例程。

Sub Kaleidoscope()
Dim r, g, b, i As Integer, ms As Double

ms = 0.0000000115741
For i = 1 To 1000
    r = WorksheetFunction.RandBetween(1, 255)
    g = WorksheetFunction.RandBetween(1, 255)
    b = WorksheetFunction.RandBetween(1, 255)
    Range("A1").Interior.Color = RGB(r, g, b)
    Range("A1").Value = i
    For j = Now To (Now + (ms * i))
        DoEvents
    Next j
    
Next i

End Sub

Answer 2

这是我达到你的 objective 的唯一方法运行 - 时间为 2 分 9 秒。

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

'   run time on my computer 2:09:07
'   runs from 6 ms to 751.5 ms
Sub ewhgfsd()
Dim StartTime As Double
Dim EndTime As Double

StartTime = Timer

For i = 1 To 500
    ms = ms + (i * 0.006)
    r = WorksheetFunction.RandBetween(1, 255)
    g = WorksheetFunction.RandBetween(1, 255)
    b = WorksheetFunction.RandBetween(1, 255)
    Range("A1").Interior.Color = RGB(r, g, b)
    Sleep ms
    Range("B1").Value = "Time: " & Format(Timer - StartTime, "####.##")
    Range("C1").Value = "ms =  " & Format(ms, "####.#####")
    Range("D1").Value = i & " of 500"
Next i

EndTime = Timer - StartTime
Debug.Print Format(EndTime, "####.##")
End Sub

Answer 3

您可以使用 winAPI 的睡眠功能。

模块顶部：

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

然后在你的代码中：

Sleep i ' where i is now in milliseconds

请注意，睡眠会延迟所有 VBA 代码。

Application.Wait 破坏了我的代码

Application.Wait Breaks my Code

excel

vba

excel-2007

wait

0m3r 是正确的。问题出在 application.wait 函数上。请尝试以下执行事件例程。