在Worksheet_Change事件中结合Select Case处理单元格与区域的问题

我来帮你排查这个Worksheet_Change事件的问题，你遇到的情况大概率是几个常见的VBA事件陷阱导致的，咱们一步步来修正：

核心问题分析 #

你的代码失效主要可能是这两个原因：

1. 事件重入：当你从另一个工作表取值写入当前表时，会再次触发Worksheet_Change，导致循环执行或报错
2. 区域判断逻辑错误：直接用Select Case Target.Address无法处理多单元格变化的场景，且匹配逻辑不够可靠

修正后的完整代码 #

把这段代码放到你需要监控的工作表模块里（不是标准模块）：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 保存当前系统状态，确保出错后能恢复
    Dim originalEvents As Boolean
    Dim originalScreenUpdating As Boolean
    originalEvents = Application.EnableEvents
    originalScreenUpdating = Application.ScreenUpdating
    
    ' 错误捕获：一旦出错就跳转到恢复设置的代码块
    On Error GoTo Cleanup

    ' 关闭事件触发，避免循环执行；关闭屏幕更新提升性能
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    ' 处理G6单元格变化的弹窗逻辑
    If Not Intersect(Target, Me.Range("$G$6")) Is Nothing Then
        MsgBox "G6单元格的值变啦！", vbInformation, "提示"
    End If

    ' 处理G24:H54区域变化的取值逻辑
    Dim changedCells As Range
    Set changedCells = Intersect(Target, Me.Range("$G$24:$H$54"))
    If Not changedCells Is Nothing Then
        Dim cell As Range
        ' 遍历所有变化的单元格，从其他工作表取对应值（这里以Sheet2为例，你可以按需修改）
        For Each cell In changedCells
            cell.Value = ThisWorkbook.Sheets("Sheet2").Cells(cell.Row, cell.Column).Value
        Next cell
    End If

Cleanup:
    ' 恢复系统原始设置，不管代码是否出错都要执行
    Application.EnableEvents = originalEvents
    Application.ScreenUpdating = originalScreenUpdating
    
    ' 如果有错误，弹窗提示具体信息
    If Err.Number <> 0 Then
        MsgBox "代码执行出错：" & Err.Description, vbCritical, "错误提示"
        Err.Clear
    End If
End Sub

关键细节说明 #

• 用Intersect判断目标区域：这是VBA处理单元格变化事件的标准写法，能准确识别Target是否和你关心的区域重叠，不管Target是单个还是多个单元格
• 必须关闭EnableEvents：当你在事件里修改单元格值时，会再次触发Worksheet_Change，关闭事件能避免无限循环
• 错误处理块Cleanup：确保即使代码中途出错，也能恢复系统设置，不然会导致后续单元格变化不再触发事件，或者界面一直处于卡顿状态
• 不要用Select Case Target.Address：当Target是多个单元格时，Address会返回区域地址（比如$G$24:$G$25），根本匹配不上你写的单个地址或固定区域

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