Excel VBA：合并工作表变更事件实现行迁移与更新时间记录

需求概述 #

• 当F列单元格输入Completed时，将对应整行移动至指定工作表
• 只要B3:L5000范围内的任意单元格发生变更，就为对应行的G列添加最后更新的日期和时间

原代码问题点 #

原代码存在多处逻辑和语法错误，无法正常实现需求：

• 存在无对应For循环的Next AffectedRange语句，触发语法报错
• 判断完成状态时用Target(Z).Value > 0，完全不符合输入Completed的需求逻辑
• 事件启用/禁用逻辑混乱，可能导致后续变更事件失效
• 多单元格变更时直接退出，无法批量更新最后修改日期
• 未定义MoveBasedOnValue过程，移动功能无法执行

修正后的完整VBA代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim targetCell As Range
    Dim destSheet As Worksheet
    
    ' 替换为你实际要移动到的工作表名称
    Set destSheet = ThisWorkbook.Worksheets("已完成")
    
    Application.EnableEvents = False
    On Error GoTo Cleanup
    
    ' 处理最后更新日期：遍历所有变更的有效单元格
    For Each targetCell In Intersect(Target, Me.Range("B3:L5000"))
        Me.Cells(targetCell.Row, "G").Value = Now() ' 记录日期+时间，仅需日期可改用Date()
    Next targetCell
    
    ' 处理Completed行移动：检查F列的变更
    For Each targetCell In Intersect(Target, Me.Range("F:F"))
        ' 不区分大小写判断，同时去除首尾空格
        If UCase(Trim(targetCell.Value)) = "COMPLETED" Then
            ' 复制整行到目标工作表的最后一行下方
            targetCell.EntireRow.Copy destSheet.Cells(destSheet.Rows.Count, 1).End(xlUp).Offset(1)
            ' 删除原工作表中的该行
            targetCell.EntireRow.Delete
        End If
    Next targetCell

Cleanup:
    Application.EnableEvents = True ' 确保事件始终恢复
    If Err.Number <> 0 Then
        MsgBox "执行错误：" & Err.Description, vbExclamation
    End If
End Sub

代码关键说明 #

• 事件控制：操作前禁用事件防止循环触发，通过错误处理块确保事件最终一定会恢复，避免后续功能失效
• 更新日期记录：遍历所有变更的单元格，只要在B3:L5000范围内，就同步更新对应行G列的时间戳
• 完成行移动：对F列的变更单元格做不区分大小写的匹配，复制整行到目标工作表的末尾后删除原行，确保数据转移完整
• 自定义调整：需要将代码中的"已完成"替换为你实际使用的目标工作表名称

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