excel - Application.Wait 破坏了我的代码

Question

Original

我有以下代码为单元格着色以演示毫秒等待时间的使用。然而，当 i = 500代码中断。我得到的错误是 Code Execution has been Interrupted从 500 到 1000 我必须继续点击继续。我试图将我的代码包装在 Application.DisplayAlerts = False 中和 True但它仍然会被打断并且不会完成。我估计这段代码大约需要 6 分钟，因为 i接近 1000 .我不知道是什么原因造成的。我已经完成了我能想到的所有设置，并且它不会持续超过 500 而不会中断。 ms 计算自 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 (stackoverflow.com/a/5823507/5175942) 提供的链接解决了我的问题的初始问题。但是，它似乎仍然没有正确增加。就好像它没有等到 i = 500然后似乎每次都停止 1 秒。这是您所说的限制，最终不可能等待 1 毫秒吗？无需更改原始代码即可防止破坏。

Final Thoughts

@JohnMuggins 对我的原始代码进行了很好的调整，并提供了额外的工具来查看幕后的计算。不过，Ultimatley 还必须像 @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

您可以使用 winAPI 中的 Sleep 函数。

在模块顶部:
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
然后在您的代码中:
Sleep i ' where i is now in milliseconds
请注意， sleep 会延迟所有 VBA 代码。