Excel VBA 实现B列RTD更新时对应A列自动插入含毫秒时间戳

适配B列1000个RTD单元格更新的宏代码 #

Private Sub Worksheet_Calculate()
    ' 定义静态数组存储B2到B1001共1000个单元格的历史值，静态变量在事件触发后存储的值不会丢失
    Static oldValArr(1 To 1000) As Variant
    Dim i As Long
    
    ' 遍历处理B2到B1001的1000行数据
    For i = 1 To 1000
        ' 定位当前处理的B列单元格
        With Range("B" & i + 1)
            ' B列单元格为空时，对应A列同步清空
            If .Value = "" Then
                Range("A" & i + 1).Value = ""
                oldValArr(i) = ""
            Else
                ' 数值与历史存储值不一致时，更新对应A列的时间戳
                If .Value <> oldValArr(i) Then
                    oldValArr(i) = .Value
                    ' 保留原有时间计算逻辑，如需记录更新的绝对系统时间，可将[now()] - tStart替换为Now()
                    Range("A" & i + 1).Value = Application.WorksheetFunction.Text([now()] - tStart, "h:mm:ss.000")
                End If
            End If
        End With
    Next i
End Sub

改动说明 #

• 原代码仅用单个静态变量存储单单元格历史值，替换为长度为1000的静态数组，对应存储B2到B1001所有单元格的历史数值，适配整列批量判断需求
• 新增循环逻辑逐行处理，每行的判断规则完全沿用你原有单单元格逻辑，没有修改业务规则
• 如需调整覆盖的行数，直接修改数组长度和循环的上限数值即可

注意事项 #

如果代码中引用的tStart是你提前定义的工作簿启动计时基准，无需修改时间计算逻辑；如果你需要记录单元格更新的实际系统时间，把[now()] - tStart替换为Now()即可。1000行的循环计算量极小，即使RTD更新频率较高也不会出现卡顿。

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