VBA需求：粘贴至指定区域时添加覆盖确认并阻止误粘贴

原代码的核心问题有两个：

• Worksheet_Change 事件是在数据已经完成修改后触发的，默认粘贴操作已经完成，必须通过撤销操作来还原；
• Target.Address = "$A$15:$E$33" 的判断逻辑过于严格，只有当修改区域完全等于A15:E33时才会触发，部分区域粘贴（比如只粘贴A15:C20）不会被检测到。

修正后的代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim targetRange As Range
    Set targetRange = Me.Range("A15:E33")
    
    ' 检查修改区域是否与目标区域重叠
    If Not Intersect(Target, targetRange) Is Nothing Then
        Dim answer As Integer
        answer = MsgBox("即将覆盖现有数据，是否继续？", vbQuestion + vbYesNo, "确认操作")
        
        ' 关闭事件触发，避免Undo时再次触发Change事件
        Application.EnableEvents = False
        
        If answer = vbYes Then
            ' 直接赋值时间戳，替代复制粘贴的冗余操作
            Me.Range("B2").Value = Now()
        Else
            ' 撤销刚才的粘贴操作
            Application.Undo
            MsgBox "操作已取消"
        End If
        
        ' 恢复事件触发
        Application.EnableEvents = True
    End If
End Sub

关键改进点 #

• 使用 Intersect(Target, targetRange) 检测修改区域是否涉及A15:E33，覆盖所有部分修改的场景；
• 执行 Application.Undo 撤销已完成的粘贴操作，实现“取消粘贴”的需求；
• 加入 Application.EnableEvents = False/True 防止Undo操作再次触发Worksheet_Change事件，避免无限循环；
• 优化时间戳赋值逻辑，直接用Now()赋值替代复制粘贴，代码更简洁高效。

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