Excel Worksheet.Change事件无法捕获单元格删除移位后的全部变更

当对选中单元格执行右键→Delete...→Shift cells up/left操作时，Worksheet.Change事件接收的Target范围仅对应原选中区域，并未包含因向上/向左移位而发生变动的单元格。

示例场景 #

初始工作表数据：

选中区域B1:C1并执行右键→Delete...→Shift cells up操作后，工作表变为：

执行以下Worksheet.Change事件代码：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Debug.Print Target.Address
End Sub

输出的变更单元格为$B$1:$C$1（原选中区域），但实际$B$1:$C$3区域均已发生变更。

请问是否存在简洁高效的方法，可检测到发生变更的最小单元格范围？此前尝试的方法要么性能低下，要么无法覆盖部分边缘场景。

可以通过Excel的Undo/Redo栈快速对比操作前后的单元格状态，结合行列边界计算，高效定位实际变更的最小范围，避免全表遍历的性能损耗，同时覆盖各类边缘场景。

实现代码 #

在Workbook模块中添加以下代码：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim actualTarget As Range
    Dim lastRow As Long, lastCol As Long
    Dim isShiftOp As Boolean
    
    ' 利用Undo/Redo验证是否为删除移位操作
    On Error Resume Next
    Application.Undo
    Dim prevTargetVal As Variant
    prevTargetVal = Target.Value
    ' 撤销前后Target从有值变空，即可判定为删除移位操作
    isShiftOp = Not IsEmpty(prevTargetVal) And IsEmpty(Target.Value)
    Application.Redo
    On Error GoTo 0
    
    If isShiftOp Then
        ' 判断移位方向：对比撤销前后Target下方单元格的状态
        On Error Resume Next
        Application.Undo
        lastRow = Sh.Cells(Sh.Rows.Count, Target.Column).End(xlUp).Row
        Dim belowPrevVal As Variant
        belowPrevVal = Sh.Range(Target.Offset(1, 0), Sh.Cells(lastRow, Target.Column + Target.Columns.Count - 1)).Value
        Application.Redo
        On Error GoTo 0
        
        If Not IsEmpty(belowPrevVal) Then
            ' Shift cells up：实际范围为原Target顶行到该列最后非空行，列与原Target一致
            Set actualTarget = Sh.Range(Target.Cells(1, 1), Sh.Cells(lastRow, Target.Column + Target.Columns.Count - 1))
        Else
            ' Shift cells left：实际范围为原Target最左列到该行最后非空列，行与原Target一致
            lastCol = Sh.Cells(Target.Row, Sh.Columns.Count).End(xlToLeft).Column
            Set actualTarget = Sh.Range(Target.Cells(1, 1), Sh.Cells(Target.Row + Target.Rows.Count - 1, lastCol))
        End If
        
        ' 输出实际变更范围（可替换为你的业务逻辑）
        Debug.Print "实际变更范围：" & actualTarget.Address
    Else
        ' 普通变更场景，直接使用原Target
        Debug.Print "变更范围：" & Target.Address
    End If
End Sub

方法优势 #

• 性能高效：仅针对Target相关行列计算边界，无需遍历全表；Undo/Redo是Excel内部机制，耗时极短
• 覆盖边缘场景：自动适配最后一行/列删除移位、多单元格选中删除等情况
• 逻辑简洁：通过状态对比直接定位操作类型，无需复杂的事件组合监听

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