动态创建工作表中Worksheet_Change事件指定范围触发异常排查

核心问题：事件代码存放位置错误 #

动态创建的*SP Temp*工作表，其Worksheet_Change事件代码必须存放在该工作表自身的代码模块中。如果你的代码放在原有工作表的模块里，新工作表的修改操作根本不会触发这段代码——每个工作表的事件代码只属于自己的模块。

其他代码逻辑问题 #

1. ActiveSheet的误用
   触发Worksheet_Change时，活动工作表不一定是发生修改的工作表。应该直接用事件所属工作表：

   • 若代码在目标工作表模块，用Me指代当前工作表
   • 或用Target.Parent获取触发事件的工作表对象

2. 未限定工作表的Range引用
   代码中Range("A1:K10")默认指向代码所在工作表的范围，不是动态创建的工作表，必须明确指定：sh.Range("A1:K10")

3. 统计逻辑效率低下
   循环遍历单元格统计"S"的写法冗余，直接用WorksheetFunction.CountIf更简洁高效。

4. 未处理事件重入
   给D12、D13赋值时会再次触发Worksheet_Change，导致重复执行甚至出错，需先关闭事件，完成后再恢复。

修正后的实现方案 #

方案1：动态给新工作表添加事件代码（推荐） #

在创建工作表的按钮代码中，直接给新工作表的模块插入事件代码：

Sub 创建SPTemp工作表()
    Dim newSh As Worksheet
    Set newSh = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    newSh.Name = "SP Temp_" & Format(Now(), "YYYYMMDDHHMMSS") ' 生成唯一名称
    
    ' 给新工作表模块添加事件代码
    Dim vbaModule As Object
    Set vbaModule = ThisWorkbook.VBProject.VBComponents(newSh.CodeName).CodeModule
    
    With vbaModule
        .InsertLines .CountOfLines + 1, "Private Sub Worksheet_Change(ByVal Target As Range)"
        .InsertLines .CountOfLines + 1, "    Dim targetRange As Range"
        .InsertLines .CountOfLines + 1, "    Set targetRange = Me.Range(""A1:K10"")"
        .InsertLines .CountOfLines + 1, ""
        .InsertLines .CountOfLines + 1, "    If Not Intersect(Target, targetRange) Is Nothing Then"
        .InsertLines .CountOfLines + 1, "        Application.EnableEvents = False ' 关闭事件防止重入"
        .InsertLines .CountOfLines + 1, "        Dim countOfS As Integer"
        .InsertLines .CountOfLines + 1, "        countOfS = WorksheetFunction.CountIf(targetRange, ""S"")"
        .InsertLines .CountOfLines + 1, "        Me.Range(""D12"").Value = countOfS"
        .InsertLines .CountOfLines + 1, "        Me.Range(""D13"").Value = SCount - countOfS"
        .InsertLines .CountOfLines + 1, "        Application.EnableEvents = True ' 恢复事件"
        .InsertLines .CountOfLines + 1, "    End If"
        .InsertLines .CountOfLines + 1, "End Sub"
    End With
End Sub

注意：需开启宏信任设置中的"信任对VBA项目对象模型的访问"（文件>选项>信任中心>信任中心设置>宏设置）

方案2：使用类模块监听工作表事件 #

若不想动态插入代码，可通过类模块统一监听：

1. 插入类模块，命名为clsSheetWatcher，写入：

Public WithEvents WatchSheet As Worksheet

Private Sub WatchSheet_Change(ByVal Target As Range)
    If WatchSheet.Name Like "*SP Temp*" Then
        Dim targetRange As Range
        Set targetRange = WatchSheet.Range("A1:K10")
        If Not Intersect(Target, targetRange) Is Nothing Then
            Application.EnableEvents = False
            Dim countOfS As Integer
            countOfS = WorksheetFunction.CountIf(targetRange, "S")
            WatchSheet.Range("D12").Value = countOfS
            WatchSheet.Range("D13").Value = SCount - countOfS
            Application.EnableEvents = True
        End If
    End If
End Sub

2. 在标准模块中写入：

Dim sheetWatchers As Collection

Sub 初始化监听()
    Set sheetWatchers = New Collection
    Dim sh As Worksheet, watcher As clsSheetWatcher
    ' 监听现有符合条件的工作表
    For Each sh In ThisWorkbook.Sheets
        If sh.Name Like "*SP Temp*" Then
            Set watcher = New clsSheetWatcher
            Set watcher.WatchSheet = sh
            sheetWatchers.Add watcher
        End If
    Next sh
End Sub

Sub 创建SPTemp工作表()
    Dim newSh As Worksheet, watcher As clsSheetWatcher
    Set newSh = ThisWorkbook.Sheets.Add
    newSh.Name = "SP Temp_New"
    ' 给新工作表添加监听
    Set watcher = New clsSheetWatcher
    Set watcher.WatchSheet = newSh
    sheetWatchers.Add watcher
End Sub

注意：需在ThisWorkbook的Workbook_Open事件中调用初始化监听，确保打开工作簿时自动启动监听。

额外注意事项 #

• 确保全局变量SCount已被正确赋值，否则D13会显示错误值
• 若手动修改工作表名称为*SP Temp*，方案2需重新执行初始化监听，或在工作表重命名事件中补充监听逻辑

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