Excel VBA Change Event：解决Application.Undo后无法定位原Target单元格问题

我有一个嵌入Change Event的工作表，触发时会跳转至指定范围，把单元格新旧数据存入数组，写入"Change Log"工作表记录变更。

现在的问题出在Application.Undo代码段：这段代码用来获取变更单元格的原始数据，但我希望代码选中用户最后操作的Target单元格，而非用Offset偏移。但Application.Undo会清除最后一次Target操作记录，导致实现不了这个需求。

原代码模块 #

Change Event 主代码 #

Dim RangeValues As Variant, E As Long, boolOne As Boolean, TgValue 
Dim sh As Worksheet: Set sh = Worksheets("Change Log")
Dim UN As String: UN = Application.UserName

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

''''''Name Change
Application.ScreenUpdating = False                                      
Application.Calculation = xlCalculationManual
If Not Intersect(Target, Union(RNG1, RNG2, RNG3, RNG4, RNG5, RNG6, RNG7, RNG8, RNG9, RNG10, RNG11, RNG12, RNG13, RNG14, RNG15, RNG16, RNG17, RNG18, RNG19, RNG20, RNG21, RNG22, RNG23, RNG24, RNG25, RNG26, RNG27, RNG28, RNG29, RNG30)) Is Nothing Then
    If Target.Cells.Count > 1 Then
        TgValue = extractData(Target)
    Else
        TgValue = Array(Array(Target.Value, Target.Address(0, 0)))  'put the target range in an array (or as a string for a single cell)
        boolOne = True
    End If
    Application.EnableEvents = False                                
        Application.Undo
        RangeValues = extractData(Target)                           
        putDataBack TgValue, ActiveSheet                            
            If boolOne Then Target.Offset(, 1).Select
    Application.EnableEvents = True

    For E = 0 To UBound(RangeValues)
        If RangeValues(E)(0) <> TgValue(E)(0) Then
            sh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 8).Value = _
                    Array(Now, UN, RangeValues(E)(1), Target.Offset(E, -2).Cells(1).Value, RangeValues(E)(0), TgValue(E)(0), Target.Offset(E, 2).Cells(1).Value, Target.Parent.Name)
        End If
    Next E
End If

putDataBack 子过程 #

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

extractData 函数 #

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 'creating a jagged array containing the values and the cells address
            For i = 1 To a.Cells.Count
                arr(count) = Array(a.Cells(i).Value, a.Cells(i).Address(0, 0)): count = count + 1
            Next
    Next
    extractData = arr
End Function

核心思路是提前保存原Target单元格的地址，在执行Application.Undo并恢复数据后，通过地址重新定位选中该单元格，绕过Undo对操作记录的清除影响。

修改后的完整Change Event代码 #

Dim RangeValues As Variant, E As Long, boolOne As Boolean, TgValue 
Dim sh As Worksheet: Set sh = Worksheets("Change Log")
Dim UN As String: UN = Application.UserName
Dim originalTargetAddr As String ' 新增：保存原Target单元格地址

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

''''''Name Change
Application.ScreenUpdating = False                                      
Application.Calculation = xlCalculationManual
If Not Intersect(Target, Union(RNG1, RNG2, RNG3, RNG4, RNG5, RNG6, RNG7, RNG8, RNG9, RNG10, RNG11, RNG12, RNG13, RNG14, RNG15, RNG16, RNG17, RNG18, RNG19, RNG20, RNG21, RNG22, RNG23, RNG24, RNG25, RNG26, RNG27, RNG28, RNG29, RNG30)) Is Nothing Then
    If Target.Cells.Count > 1 Then
        TgValue = extractData(Target)
    Else
        originalTargetAddr = Target.Address(0, 0) ' 保存用户操作的原单元格地址
        TgValue = Array(Array(Target.Value, originalTargetAddr))
        boolOne = True
    End If
    Application.EnableEvents = False                                
        Application.Undo
        RangeValues = extractData(Target)                           
        putDataBack TgValue, ActiveSheet                            
            If boolOne Then ActiveSheet.Range(originalTargetAddr).Select ' 直接选中原Target单元格
    Application.EnableEvents = True

    For E = 0 To UBound(RangeValues)
        If RangeValues(E)(0) <> TgValue(E)(0) Then
            sh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 8).Value = _
                    Array(Now, UN, RangeValues(E)(1), Target.Offset(E, -2).Cells(1).Value, RangeValues(E)(0), TgValue(E)(0), Target.Offset(E, 2).Cells(1).Value, Target.Parent.Name)
        End If
    Next E
End If

关键修改说明 #

1. 新增originalTargetAddr变量，在获取用户输入的新值时，同步保存原Target单元格的地址字符串；
2. 将原代码中Target.Offset(,1).Select替换为ActiveSheet.Range(originalTargetAddr).Select，直接通过地址定位并选中用户最初操作的单元格；
3. 保留原有的变更日志功能，所有数据对比、写入逻辑不受影响。

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