优化单元格变更记录Macro：避免批量记录删除行/列的每个单元格

这个问题太常见了——Excel的Worksheet_Change事件在删除行/列时，会触发每个被删除单元格的变更事件，直接导致日志泛滥甚至表格崩溃。我们可以通过在事件中精准检测行/列删除操作，替换逐个单元格记录的逻辑，完美解决这个问题。

核心思路 #

利用Application.Undo和Application.Redo的特性判断操作类型：删除行/列后，原单元格区域会消失；执行Undo恢复操作后，该区域又会重新存在。通过这个对比，我们可以精准识别行列删除行为，只记录一次操作而非每个单元格。

修改后的完整代码 #

把原来的Worksheet_Change事件替换为以下代码（记得把"日志"改成你的日志工作表实际名称）：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsLog As Worksheet
    Set wsLog = ThisWorkbook.Worksheets("日志") ' 替换为你的日志表名称
    Dim isRowDelete As Boolean, isColDelete As Boolean
    Dim deletedRange As String
    Dim originalTargetAddr As String
    
    ' 禁用事件，避免循环触发
    Application.EnableEvents = False
    
    ' 错误处理：确保事件始终能恢复，防止意外锁死
    On Error GoTo Cleanup

    originalTargetAddr = Target.Address
    
    ' 执行Undo，检查原区域是否存在（判断是否是删除操作）
    Application.Undo
    Dim testRange As Range
    On Error Resume Next
    Set testRange = Me.Range(originalTargetAddr)
    On Error GoTo Cleanup
    
    ' 判断是行删除还是列删除
    If testRange Is Nothing Then
        If Target.Columns.Count = Me.Columns.Count Then
            ' 删除的是行：Target是整行区域，列数等于工作表总列数
            isRowDelete = True
            deletedRange = GetRowLabel(Target.Rows)
        ElseIf Target.Rows.Count = Me.Rows.Count Then
            ' 删除的是列：Target是整列区域，行数等于工作表总行数
            isColDelete = True
            deletedRange = GetColumnLabel(Target.Columns)
        End If
    End If
    
    ' 恢复原删除操作
    Application.Redo
    
    ' 写入日志
    If isRowDelete Then
        With wsLog.Cells(wsLog.Rows.Count, 1).End(xlUp).Offset(1, 0)
            .Value = "已删除行: " & deletedRange & " | 时间: " & Now()
            .NumberFormat = "@" ' 设置为文本格式，避免时间被自动转换
        End With
    ElseIf isColDelete Then
        With wsLog.Cells(wsLog.Rows.Count, 1).End(xlUp).Offset(1, 0)
            .Value = "已删除列: " & deletedRange & " | 时间: " & Now()
            .NumberFormat = "@"
        End With
    Else
        ' 保留原有的单个单元格变更记录逻辑（可根据需求调整或删除）
        With wsLog.Cells(wsLog.Rows.Count, 1).End(xlUp).Offset(1, 0)
            .Value = "单元格变更: " & Target.Address & " | 时间: " & Now()
            .NumberFormat = "@"
        End With
    End If

Cleanup:
    ' 恢复事件触发，务必执行！否则后续变更事件会失效
    Application.EnableEvents = True
    On Error GoTo 0
End Sub

' 辅助函数：把行范围转为友好的文本（如"3-5"）
Private Function GetRowLabel(rngRows As Range) As String
    If rngRows.Count = 1 Then
        GetRowLabel = CStr(rngRows.Row)
    Else
        GetRowLabel = CStr(rngRows.Row) & "-" & CStr(rngRows.Row + rngRows.Count - 1)
    End If
End Function

' 辅助函数：把列范围转为字母标识（如"B-D"）
Private Function GetColumnLabel(rngCols As Range) As String
    If rngCols.Count = 1 Then
        GetColumnLabel = Split(Cells(1, rngCols.Column).Address, "$")(1)
    Else
        Dim startCol As String, endCol As String
        startCol = Split(Cells(1, rngCols.Column).Address, "$")(1)
        endCol = Split(Cells(1, rngCols.Column + rngCols.Count - 1).Address, "$")(1)
        GetColumnLabel = startCol & "-" & endCol
    End If
End Function

关键细节说明 #

1. 事件禁用与恢复：开头必须禁用Application.EnableEvents，否则Undo/Redo会再次触发Worksheet_Change事件造成循环。Cleanup分支确保无论是否出错，事件都会恢复。
2. 删除操作检测：通过Undo后检查原Target区域是否存在，精准判断是否为行列删除，不会误判普通单元格编辑。
3. 友好的范围标识：两个辅助函数把枯燥的行/列号转为用户易读的格式（如行3-5、列B-D）。
4. 日志格式优化：设置单元格为文本格式，避免时间被Excel自动转换为数值，保证日志可读性。

替代方案（如果Undo/Redo不适用） #

如果你的场景不允许使用Undo（比如需要保留操作历史的连续状态），可以改用Worksheet_SelectionChange记录选中区域，再在Worksheet_Change中对比选中区域与当前Target的差异，判断是否为行列删除。但这种方法可靠性稍差，不如Undo/Redo方案稳定。

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