基于条件触发器迁移Excel多行列的VBA实现问题

核心思路 #

利用工作表的Worksheet_Change事件监听「Status」列（I列）的修改，当单元格值变为Discontinued时，提取对应行的「Unique ID」，筛选活跃表中所有该ID的行，批量移动到归档表并删除原行。

完整VBA代码 #

将以下代码粘贴到CVL工作表的代码模块中（右键工作表标签→查看代码）：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsActive As Worksheet, wsArchive As Worksheet
    Dim tblActive As ListObject, tblArchive As ListObject
    Dim uniqueID As Variant
    Dim filterRange As Range, deleteRange As Range
    
    ' 初始化工作表和表格对象
    Set wsActive = ThisWorkbook.Worksheets("CVL")
    Set wsArchive = ThisWorkbook.Worksheets("Archived_CVL")
    Set tblActive = wsActive.ListObjects("CVL")
    Set tblArchive = wsArchive.ListObjects("Archived_CVL")
    
    ' 仅处理「Status」列的单单元格修改，避免批量操作误触发
    If Target.Column = tblActive.ListColumns("Status").Index And Target.Count = 1 Then
        ' 判断修改后的值是否为Discontinued
        If UCase(Target.Value) = "DISCONTINUED" Then
            ' 获取当前行的Unique ID
            uniqueID = tblActive.ListRows(Target.Row - tblActive.HeaderRowRange.Row).Range(tblActive.ListColumns("Unique ID").Index).Value
            
            ' 关闭事件触发，避免移动行时重复触发Change事件
            Application.EnableEvents = False
            
            ' 筛选活跃表中所有匹配该Unique ID的行
            tblActive.Range.AutoFilter Field:=tblActive.ListColumns("Unique ID").Index, Criteria1:=uniqueID
            
            ' 获取筛选后的可见数据行（排除表头）
            On Error Resume Next
            Set filterRange = tblActive.DataBodyRange.SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            
            If Not filterRange Is Nothing Then
                ' 将筛选行复制到归档表的最后一行
                filterRange.Copy
                tblArchive.ListRows.Add.Range.PasteSpecial xlPasteValuesAndNumberFormats
                
                ' 标记要删除的行，避免直接删除导致行号错乱
                If deleteRange Is Nothing Then
                    Set deleteRange = filterRange
                Else
                    Set deleteRange = Union(deleteRange, filterRange)
                End If
                
                ' 删除活跃表中的对应行
                deleteRange.Delete xlShiftUp
            End If
            
            ' 取消筛选
            tblActive.Range.AutoFilter
            
            ' 恢复事件触发
            Application.EnableEvents = True
        End If
    End If
End Sub

关键代码说明 #

• 事件触发限制：仅监听「Status」列的单单元格修改，避免批量操作误触发流程。
• Unique ID定位：通过表格对象的ListRows和ListColumns索引获取ID，即使表格列顺序调整也能正常工作。
• 批量处理逻辑：用自动筛选批量选中目标行，比逐行循环效率更高；关闭事件触发防止移动行时重复触发Worksheet_Change。
• 错误防护：添加On Error Resume Next避免无匹配行时的报错。

注意事项 #

1. 确保「Unique ID」和「Status」的列名与代码中一致（区分大小写）。
2. 归档表Archived_CVL需保持与活跃表完全相同的列结构。
3. 测试前建议备份工作簿，防止数据丢失。

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