Application.Wait 破坏了我的代码

Question

原创

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

提前谢谢你！

更新

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

最后的想法

@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 中的睡眠功能。

模块顶部：

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

然后在你的代码中：

Sleep i ' where i is now in milliseconds

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

Answer 2

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 3

这是我达到你的运行时间 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