为何Application.OnTime未等待1秒？如何每秒更新单元格及图表

原代码的核心问题 #

你的代码里Do While循环和Application.OnTime的逻辑完全冲突，导致无法实现1秒间隔：

• Do While是同步循环，会持续快速执行循环体，每次都调用Application.OnTime注册一个新的定时任务。
• Application.OnTime是异步调度，它只是告诉Excel“在指定时间运行这个过程”，然后立刻回到当前代码继续执行。这会导致瞬间生成大量定时任务，1秒后这些任务几乎同时触发，看起来完全没有等待间隔。
• 另外，Application.Wait会阻塞Excel的事件循环，期间Excel不会处理图表重绘，所以即使单元格值更新了，图表也不会同步刷新。

修正后的代码 #

把循环逻辑改成OnTime的递归调用，每次执行完后检查运行条件，再注册下一次的定时任务，同时主动刷新图表确保更新：

Sub graphOverTime()
    ' 检查是否继续运行，不满足则直接退出
    If Range("N5").Value <> "Running" Then Exit Sub
    
    ' 执行自定义逻辑（修改N5的状态）
    Call my_procedure
    
    ' 更新影响图表的D3单元格值
    Dim current_month As Date
    current_month = Range("D3").Value
    Range("D3").Value = Application.WorksheetFunction.EoMonth(current_month, 1)
    
    ' 强制刷新当前工作表的所有图表
    Dim chtObj As ChartObject
    For Each chtObj In ActiveSheet.ChartObjects
        chtObj.Chart.Refresh
    Next chtObj
    
    ' 让Excel处理重绘事件，确保图表显示更新后的数据
    DoEvents
    
    ' 注册1秒后的下一次执行
    Application.OnTime Now + TimeValue("0:00:01"), "graphOverTime"
End Sub

关键说明 #

1. 去掉同步循环：用OnTime递归调用代替Do While，每次执行完仅注册下一次任务，确保严格的1秒间隔。
2. 主动刷新图表：通过遍历ChartObjects调用Refresh，强制图表读取最新的单元格数据，解决Application.Wait导致的不更新问题。
3. 停止逻辑：当N5的值改为Not running时，下一次OnTime触发时会直接退出，不会再注册新任务，程序自动停止。

内容的提问来源于stack exchange，提问作者thestarwarsnerd