Excel VBA Worksheet_Change事件仅偶尔触发问题求助

我给表格做了个自定义筛选器，放在名为_business_area_dropdown_filter的单元格里，下拉选项用数据验证生成，只显示Business Area列的唯一项。但写的VBA子程序只有约50%的概率触发，已确认EnableEvents处于开启状态，工作簿为.xlsb格式，其他VBA代码运行正常，这段代码位于工作表代码模块中。试过在子程序末尾添加Cells(4, 2).Activate，仍无法实现每次更改下拉值都触发事件，附上代码求助：

Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = ActiveSheet.Range("_business_area_dropdown_filter").Address Then
        
        Dim first_row As Integer: first_row = ActiveSheet.Range("_header_row").row + 2
        Dim team_column As Integer: team_column = Rows(first_row - 2).EntireRow.Find("Team", LookIn:=xlValues).Column
        
        Rows(first_row & ":100").EntireRow.hidden = False
        If Target.Value = "All" Then Exit Sub

        Dim last_row As Integer: last_row = ActiveSheet.Cells(5000, team_column).End(xlUp).row
        
        Dim blanks_selected As Boolean
        blanks_selected = IIf(ActiveSheet.Range("_business_area_dropdown_filter").Value = "(Blanks)", True, False)
        
        Dim i As Integer
        For i = first_row To last_row

            If blanks_selected And Cells(i, team_column - 1).Value = "" Then
                Rows(i).EntireRow.hidden = False
            ElseIf Cells(i, team_column - 1).Value = "" Or Cells(i, team_column - 1).Value <> Target.Value Then
                Rows(i).EntireRow.hidden = True
            End If
        Next i
        Cells(4, 2).Activate
    End If
End Sub

问题根源与修复方案 #

1. Target地址匹配逻辑缺陷
   原代码用Target.Address和单元格地址字符串匹配，可能因引用格式（绝对/相对）差异导致匹配失败。改用对象交集判断更可靠，能覆盖多单元格触发场景，也避免字符串匹配的不确定性：

   ' 替换原If判断
   If Not Intersect(Target, ActiveSheet.Range("_business_area_dropdown_filter")) Is Nothing Then
   

2. 事件递归与意外抑制
   操作行隐藏时，部分场景会间接触发事件干扰，建议在代码执行前后手动控制EnableEvents，防止递归或意外关闭：

   Sub Worksheet_Change(ByVal Target As Range)
       Dim originalEvents As Boolean
       originalEvents = Application.EnableEvents
       Application.EnableEvents = False ' 临时关闭事件
   
       ' 原代码逻辑...
   
       Application.EnableEvents = originalEvents ' 恢复事件状态
   End Sub
   

3. 变量类型溢出风险
   Integer最大取值为32767，无法覆盖Excel最大行号（1048576），会导致代码溢出中断。将所有行号、列号变量改为Long类型：

   Dim first_row As Long: first_row = ActiveSheet.Range("_header_row").Row + 2
   Dim team_column As Long
   Dim last_row As Long: last_row = ActiveSheet.Cells(5000, team_column).End(xlUp).Row
   Dim i As Long
   

4. Find方法参数缺失
   Find会继承上次的查找设置（如匹配方式、搜索方向），可能导致找不到"Team"列。显式设置参数保证查找稳定性：

   Dim findRange As Range
   Set findRange = Rows(first_row - 2).EntireRow.Find( _
       What:="Team", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
   If Not findRange Is Nothing Then
       team_column = findRange.Column
   Else
       MsgBox "未找到Team列"
       Application.EnableEvents = originalEvents
       Exit Sub
   End If
   

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