VBA单元格变更追踪优化：记录计算值与自动捕获公式更新

核心问题修复 #

1. 公式单元格新值记录计算结果 #

原代码中单个单元格修改时，错误使用Target.Formula获取新值，导致日志记录的是公式文本而非计算后的值。将该部分改为Target.Value即可获取单元格的实际计算结果。

2. 公式自动刷新时触发日志 #

Worksheet_Change仅响应手动单元格修改，公式自动计算的变化需要通过Worksheet_Calculate事件捕获。通过模块级字典缓存监控区域（O32:CL32）的旧值，每次计算后对比新旧值，有差异则记录日志。

修改后的完整VBA代码 #

' 模块级别变量，用于存储监控单元格的旧值
Private oldVals As Object

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RangeValues As Variant, r As Long, boolOne As Boolean, TgValue
    Dim sh As Worksheet: Set sh = Worksheets("Log - Ratio")
    Dim UN As String: UN = Application.UserName
    
    ' 初始化日志表头（如果为空）
    If sh.Range("A1") = "" Then
        sh.Range("A1").Resize(1, 6).Value = Array("Time", "User Name", "Changed cell", "From", "To", "Sheet Name")
    End If

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    ' 仅处理O32:CL32区域的修改
    If Intersect(Target, Me.Range("O32:CL32")) Is Nothing Then GoTo Cleanup
    
    ' 获取修改后的目标值（修复：单个单元格用Value而非Formula）
    If Target.Cells.Count > 1 Then
        TgValue = extractData(Target)
    Else
        TgValue = Array(Array(Target.Value, Target.Address(0, 0)))
        boolOne = True
    End If
    
    ' 撤销获取旧值，再恢复修改
    Application.Undo
    RangeValues = extractData(Target)
    putDataBack TgValue, Me
    If boolOne Then Target.Offset(1).Select
    
    ' 记录差异到日志
    For r = 0 To UBound(RangeValues)
        If RangeValues(r)(0) <> TgValue(r)(0) Then
            sh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 6).Value = _
                Array(Now, UN, RangeValues(r)(1), RangeValues(r)(0), TgValue(r)(0), Me.Name)
            ' 更新字典中的旧值
            If Not oldVals Is Nothing Then oldVals(RangeValues(r)(1)) = TgValue(r)(0)
        End If
    Next r

Cleanup:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Calculate()
    Dim sh As Worksheet: Set sh = Worksheets("Log - Ratio")
    Dim UN As String: UN = Application.UserName
    Dim cell As Range
    Dim currentVal As Variant
    
    ' 初始化字典（首次运行时）
    If oldVals Is Nothing Then
        Set oldVals = CreateObject("Scripting.Dictionary")
        For Each cell In Me.Range("O32:CL32")
            oldVals(cell.Address(0, 0)) = cell.Value
        Next cell
        ' 初始化日志表头（如果为空）
        If sh.Range("A1") = "" Then
            sh.Range("A1").Resize(1, 6).Value = Array("Time", "User Name", "Changed cell", "From", "To", "Sheet Name")
        End If
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    ' 遍历监控区域，对比新旧值
    For Each cell In Me.Range("O32:CL32")
        currentVal = cell.Value
        If oldVals.Exists(cell.Address(0, 0)) Then
            If oldVals(cell.Address(0, 0)) <> currentVal Then
                ' 记录日志
                sh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 6).Value = _
                    Array(Now, UN, cell.Address(0, 0), oldVals(cell.Address(0, 0)), currentVal, Me.Name)
                ' 更新字典中的旧值
                oldVals(cell.Address(0, 0)) = currentVal
            End If
        Else
            ' 新增单元格（如果监控区域扩展）
            oldVals(cell.Address(0, 0)) = currentVal
        End If
    Next cell

    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Sub putDataBack(arr, sh As Worksheet)
    Dim El As Variant
    For Each El In arr
        sh.Range(El(1)).Value = El(0)
    Next
End Sub

Function extractData(Rng As Range) As Variant
    Dim a As Range, arr(), count As Long, i As Long
    ReDim arr(Rng.Cells.Count - 1)
    For Each a In Rng.Areas
        For i = 1 To a.Cells.Count
            arr(count) = Array(a.Cells(i).Value, a.Cells(i).Address(0, 0))
            count = count + 1
        Next i
    Next a
    extractData = arr
End Function

关键改动说明 #

1. 模块级字典oldVals：用于存储监控区域单元格的旧值，在Worksheet_Calculate事件中对比新值，捕获公式自动计算的变化。
2. Worksheet_Change事件修复：单个单元格处理时将Target.Formula改为Target.Value，确保记录计算后的值；同时更新字典中的旧值，保持与当前值同步。
3. 新增Worksheet_Calculate事件：遍历监控区域，对比字典中的旧值与当前计算值，有差异则记录日志，并更新字典。

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