单过程多Select Case语句实现Autofilter失效问题排查

问题描述 #

在工作表的Worksheet_Change事件过程中，使用Select Case结合AutoFilter对两个表格进行筛选：

• 关联RegionChoice下拉单元格的筛选可正常作用于两个表格
• 关联ProjectType下拉单元格的筛选完全不生效（仅需作用于一个表格）

原本使用多组if/else语句，改为Select Case后希望保留该方案，寻求问题原因。原代码如下：

'Autofilter table on Summary Tab & CapEx Project Table on Visual based on Region drop down on Visual Tab
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsSumm As Worksheet, wsVis As Worksheet
    Dim range_to_filter As Range, range_to_filter_2 As Range
    
    Set wsSumm = ThisWorkbook.Worksheets("Summary")
    Set wsVis = ThisWorkbook.Worksheets("Visual")
    Set range_to_filter = wsSumm.Range("A3:Z113")
    Set range_to_filter_2 = wsVis.Range("B80:T109")
    
    If Application.Intersect(Me.Range("RegionChoice"), Target) Is Nothing Then Exit Sub

    Select Case Me.Range("RegionChoice").Value
    
    'Central
        Case Me.Range("A1").Value
            wsSumm.Unprotect ("fac1")
            range_to_filter.AutoFilter Field:=4, Criteria1:="C"
            range_to_filter_2.AutoFilter Field:=5, Criteria1:="C"
    'South
        Case Me.Range("A2").Value
            wsSumm.Unprotect ("fac1")
            range_to_filter.AutoFilter Field:=4, Criteria1:="S"
            range_to_filter_2.AutoFilter Field:=5, Criteria1:="S"
    'West
        Case Me.Range("A3").Value
            wsSumm.Unprotect ("fac1")
            range_to_filter.AutoFilter Field:=4, Criteria1:="W"
            range_to_filter_2.AutoFilter Field:=5, Criteria1:="W"
    'Northeast
        Case Me.Range("A4").Value
            wsSumm.Unprotect ("fac1")
            range_to_filter.AutoFilter Field:=4, Criteria1:="NE"
            range_to_filter_2.AutoFilter Field:=5, Criteria1:="NE"
    'Clear
        Case Me.Range("A5").Value
            wsSumm.Unprotect ("fac1")
           range_to_filter.AutoFilter Field:=4
           range_to_filter_2.AutoFilter Field:=5

    End Select
    
    If Application.Intersect(Me.Range("ProjectType"), Target) Is Nothing Then Exit Sub

    Select Case Me.Range("ProjectType").Value
    
    'Refresh
        Case Me.Range("A9").Value
            wsVis.Unprotect ("fac1")
            range_to_filter_2.AutoFilter Field:=2, Criteria1:="Refresh"
    'Buildout
        Case Me.Range("A10").Value
            wsVis.Unprotect ("fac1")
            range_to_filter_2.AutoFilter Field:=2, Criteria1:="Buildout"
    'Maintenance
        Case Me.Range("A11").Value
            wsVis.Unprotect ("fac1")
            range_to_filter_2.AutoFilter Field:=2, Criteria1:="Maintenance"
    'Expansion
      Case Me.Range("A12").Value
            wsVis.Unprotect ("fac1")
            range_to_filter_2.AutoFilter Field:=2, Criteria1:="Expansion"
    'Furniture
      Case Me.Range("A13").Value
            wsVis.Unprotect ("fac1")
            range_to_filter_2.AutoFilter Field:=2, Criteria1:="Furniture"
    'Clear
      Case Me.Range("A14").Value
            wsVis.Unprotect ("fac1")
            range_to_filter_2.AutoFilter Field:=2

    End Select
End Sub

问题原因 #

1. 代码执行逻辑阻断：
   第一个判断If Application.Intersect(Me.Range("RegionChoice"), Target) Is Nothing Then Exit Sub会在变更的不是RegionChoice单元格时直接退出整个过程，导致后续ProjectType的筛选代码完全无法执行。只有当变更的是RegionChoice时才会进入后续代码，但此时ProjectType未发生变更，其筛选逻辑也不会触发。

2. 工作表保护未重置：
   执行筛选前解锁了工作表，但未重新保护，可能引发后续权限问题（非当前失效的直接原因，但属于代码不严谨之处）。

3. Select Case匹配风险：
   用单元格值作为Case条件，如果单元格存在空格、大小写差异等情况，可能导致匹配失败，筛选逻辑不触发。

修复后的代码 #

调整逻辑，将两个筛选分支改为独立判断，避免提前退出；同时补充工作表重新保护的步骤，优化Select Case的匹配稳定性：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsSumm As Worksheet, wsVis As Worksheet
    Dim range_to_filter As Range, range_to_filter_2 As Range
    Dim regionVal As String, projectVal As String
    
    Set wsSumm = ThisWorkbook.Worksheets("Summary")
    Set wsVis = ThisWorkbook.Worksheets("Visual")
    Set range_to_filter = wsSumm.Range("A3:Z113")
    Set range_to_filter_2 = wsVis.Range("B80:T109")
    
    ' 处理RegionChoice的筛选
    If Not Application.Intersect(Me.Range("RegionChoice"), Target) Is Nothing Then
        regionVal = Trim(Me.Range("RegionChoice").Value)
        wsSumm.Unprotect "fac1"
        
        Select Case regionVal
            Case Trim(Me.Range("A1").Value) ' Central
                range_to_filter.AutoFilter Field:=4, Criteria1:="C"
                range_to_filter_2.AutoFilter Field:=5, Criteria1:="C"
            Case Trim(Me.Range("A2").Value) ' South
                range_to_filter.AutoFilter Field:=4, Criteria1:="S"
                range_to_filter_2.AutoFilter Field:=5, Criteria1:="S"
            Case Trim(Me.Range("A3").Value) ' West
                range_to_filter.AutoFilter Field:=4, Criteria1:="W"
                range_to_filter_2.AutoFilter Field:=5, Criteria1:="W"
            Case Trim(Me.Range("A4").Value) ' Northeast
                range_to_filter.AutoFilter Field:=4, Criteria1:="NE"
                range_to_filter_2.AutoFilter Field:=5, Criteria1:="NE"
            Case Trim(Me.Range("A5").Value) ' Clear
                range_to_filter.AutoFilter Field:=4
                range_to_filter_2.AutoFilter Field:=5
        End Select
        
        wsSumm.Protect "fac1" ' 重新保护工作表
    End If
    
    ' 处理ProjectType的筛选
    If Not Application.Intersect(Me.Range("ProjectType"), Target) Is Nothing Then
        projectVal = Trim(Me.Range("ProjectType").Value)
        wsVis.Unprotect "fac1"
        
        Select Case projectVal
            Case Trim(Me.Range("A9").Value) ' Refresh
                range_to_filter_2.AutoFilter Field:=2, Criteria1:="Refresh"
            Case Trim(Me.Range("A10").Value) ' Buildout
                range_to_filter_2.AutoFilter Field:=2, Criteria1:="Buildout"
            Case Trim(Me.Range("A11").Value) ' Maintenance
                range_to_filter_2.AutoFilter Field:=2, Criteria1:="Maintenance"
            Case Trim(Me.Range("A12").Value) ' Expansion
                range_to_filter_2.AutoFilter Field:=2, Criteria1:="Expansion"
            Case Trim(Me.Range("A13").Value) ' Furniture
                range_to_filter_2.AutoFilter Field:=2, Criteria1:="Furniture"
            Case Trim(Me.Range("A14").Value) ' Clear
                range_to_filter_2.AutoFilter Field:=2
        End Select
        
        wsVis.Protect "fac1" ' 重新保护工作表
    End If
End Sub

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