如何让 NOW 函数每秒更新一次？

Question

我希望单元格中的数据B6 B8 B10每秒更新一次，而不是要求我编辑电子表格来显示实时时间。我怎样才能实现这一目标以及公式应该是什么样子？

Answer 1

该答案提供了通过实现循环在任何给定时间间隔重新计算任何范围的代码Application.OnTime。

以下代码中的示例 subUpdateSpecificRange将每秒重新计算单元格 B6 到 B10 一次。要停止更新，请致电StopUpdatingSpecificRange或StopUpdatingAll。

'Examples:
Sub UpdateSpecificRange()
    RecalculateRange ThisWorkbook.Worksheets("HOME").Range("B6:B10"), 1
End Sub

Sub StopUpdatingSpecificRange()
    RecalculateRange ThisWorkbook.Worksheets("HOME").Range("B6:B10"), 1, False
End Sub

Sub StopUpdatingAll()
    RecalculateRange stopAll:=True
End Sub

为了使这些示例正常工作，请将此子例程复制到任何标准模块中：

Public Sub RecalculateRange(Optional ByVal Range As Range = Nothing, _
                            Optional ByVal refreshTimeSec As Double = 1#, _
                            Optional ByVal schedule As Boolean = True, _
                            Optional ByVal stopAll As Boolean = False, _
                            Optional ByVal Address As String = "")
    Dim nextExec As Double, macroName As String, wasScheduled As Boolean, task
    Static tasks As Collection: If refreshTimeSec < 1 Then refreshTimeSec = 1#
    If tasks Is Nothing Then Set tasks = New Collection
    If stopAll Then
        For Each task In tasks
            Application.OnTime task(1), task(0), , False: tasks.Remove task(0)
        Next task: Exit Sub
    End If
    If Not Range Is Nothing Then Address = Range.Address(external:=True)
    Address = Replace(Address, "'", "''")
    macroName = "'RecalculateRange , " & Replace(refreshTimeSec, ",", ".") _
                & ", , , """ & Address & """'"
    On Error Resume Next: tasks macroName: wasScheduled = (err.Number = 0)
    On Error GoTo -1: On Error GoTo 0

    If schedule Then
        Application.Range(Replace(Address, "''", "'")).Calculate
        If wasScheduled Then tasks.Remove macroName
        nextExec = DateAdd("s", refreshTimeSec, Now())
        tasks.Add Item:=VBA.Array(macroName, nextExec), Key:=macroName
        Application.OnTime nextExec, macroName
    Else
        If wasScheduled Then
            Application.OnTime tasks(macroName)(1), macroName, , False
            tasks.Remove macroName
        End If
    End If
End Sub

您还可以RecalculateRange使用不同的范围和不同的更新速率多次调用。您可以停止单独更新它们，也可以使用RecalculateRange您第一次调用的相同参数（RecalculateRange包括参数）进行调用schedule:=False。RecalculateRange您还可以通过使用可选参数进行调用来立即停止更新所有这些内容，StopAll = True如下所示：RecalculateRange StopAll:=True

由于Application.OnTime工作簿关闭后可以重新打开它，因此我们必须在工作簿关闭之前停止所有计划的范围更新。这可以通过利用工作簿事件自动完成BeforeClose。为此，您必须将以下代码粘贴到ThisWorkbook代码模块中：

Option Explicit 

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    RecalculateRange StopAll:=True
End Sub

打开工作簿时自动启动更新也可以ThisWorkbook通过利用工作簿Open事件在代码模块中完成。为此，您可以将以下内容粘贴到ThisWorkbook代码模块中：

Private Sub Workbook_Open()
    RecalculateRange ThisWorkbook.Worksheets("HOME").Range("B6:B10"), 1
End Sub

要打开ThisWorkbook代码模块，请在 VBA 项目资源管理器中双击它，如以下屏幕截图中突出显示的那样：