日志变更表问题：新值记录原公式而非计算结果求解决方案

你的代码核心问题在于两处：一是保存新值时直接存储了公式文本，二是还原单元格内容时用错了赋值方式导致公式无法正确保留。以下是修改后的完整代码及关键改动说明：

修改后的完整代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim oldValues 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

    ' Uncomment the following line if you want to unprotect the sheet
    ' sh.Unprotect ""

    If sh.Range("A1") = "" Then sh.Range("A1").Resize(1, 6) = _
        Array("Time", "User Name", "Changed cell", "From", "To", "Sheet Name")

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    If Intersect(Target, Me.Range("O32:CL32")) Is Nothing Then Exit Sub
    
    ' 存储变更后的公式与单元格地址
    If Target.Cells.Count > 1 Then
        TgValue = extractData(Target)
    Else
        TgValue = Array(Array(Target.Formula, Target.Address(0, 0)))
        boolOne = True
    End If
    
    Application.EnableEvents = False
    Application.Undo
    
    ' 记录变更前的计算值与地址
    ReDim oldValues(Target.Cells.Count - 1)
    Dim cell As Range, idx As Long
    idx = 0
    For Each cell In Target
        oldValues(idx) = Array(cell.Value, cell.Address(0, 0))
        idx = idx + 1
    Next cell
    
    putDataBack TgValue, Me
    If boolOne Then Target.Offset(1).Select
    Application.EnableEvents = True

    ' 写入日志：读取还原后单元格的计算值作为新值
    For r = 0 To UBound(oldValues)
        Dim tgItem As Variant
        For Each tgItem In TgValue
            If tgItem(1) = oldValues(r)(1) Then
                Dim newValue As Variant
                newValue = Me.Range(oldValues(r)(1)).Value
                If oldValues(r)(0) <> newValue Then
                    sh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 6).Value = _
                        Array(Now, UN, oldValues(r)(1), oldValues(r)(0), newValue, Target.Parent.Name)
                End If
                Exit For
            End If
        Next tgItem
    Next r

    ' Uncomment the following line if you want to protect the sheet
    ' sh.Protect ""

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Sub putDataBack(arr, sh As Worksheet)
    Dim El As Variant
    For Each El In arr
        sh.Range(El(1)).Formula = El(0) ' 用Formula赋值确保公式被正确保留
    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).Formula, a.Cells(i).Address(0, 0)) ' 存储公式而非值
            count = count + 1
        Next
    Next
    extractData = arr
End Function

关键改动说明 #

1. extractData函数：将原代码中获取单元格.Value改为获取.Formula，目的是保存变更后的公式文本，后续还原单元格时能正确恢复公式。
2. putDataBack子过程：将.Value赋值改为.Formula赋值，避免把公式文本当成普通文本写入单元格，确保公式能正常计算。
3. 旧值记录：Undo操作后，直接读取单元格的.Value（即公式计算结果）作为旧值，避免记录公式文本。
4. 新值记录：还原单元格内容后，再次读取单元格的.Value作为新值写入日志，确保日志记录的是公式的实际计算输出，而非公式本身。

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