基于单元格条件的Excel VBA行隐藏/显示功能故障排查求助

我需要用VBA实现基于工作表E3（部门名称）、E4（站点名称）的条件，隐藏/显示表格行（表头第7行始终可见，数据从第8行开始）。已设置辅助列：

• B列：若E列值匹配E3则显示1，否则显示0
• C列：若B列为1且对应站点匹配E4则显示1，否则显示0

现有两段代码均存在问题：

• 第一段代码无法正确处理E3的"All"选项
• 第二段代码在选择单结果的部门和站点后，切换到"All"或多结果部门时，无法正常显示全部结果，甚至显示0条结果

第一段原代码 #

Option Explicit

Public Before As Variant

Private Sub Worksheet_Activate()
        Application.Calculation = xlCalculationManual
        Application.ScreenUpdating = False
        Before = Range("E3").Value
        Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

        Application.Calculation = xlCalculationManual
        Application.ScreenUpdating = False

        If Target.Address = "$E$3" Then

                For a = 8 To 909
                        If Worksheets("Dashboard").Cells(a, 2).Value = 1 Then
                                Worksheets("Dashboard").Rows(a).Hidden = False
                        Else
                                Worksheets("Dashboard").Rows(a).Hidden = True
                        End If
                Next a

        End If

        If Target.Address = "$E$4" Then

                For a = 8 To 909
                        If Worksheets("Dashboard").Cells(a, 2).Value = 1 Then
                                Worksheets("Dashboard").Rows(a).Hidden = False
                        Else
                                Worksheets("Dashboard").Rows(a).Hidden = True
                        End If
                Next a

        End If

End Sub

第二段原代码 #

Option Explicit

Public Before As Variant

Private Sub Worksheet_Activate()
        Application.Calculation = xlCalculationManual
        Application.ScreenUpdating = False
        Before = Range("E3").Value
        Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
        Dim ws As Worksheet
        Dim lastRow As Long
        Dim cell As Range
        Dim division As String
        Dim site As String
        Dim rowIndex As Long
        Dim rowsVisible As Boolean

        Set ws = Worksheets("Dashboard")

        ' Ensure headers always remain visible
        ws.Rows("1:7").Hidden = False

        ' If E3 (Division dropdown) is changed
        If Not Intersect(Target, ws.Range("E3")) Is Nothing Then
                Application.EnableEvents = False

                If ws.Range("E3").Value <> Before Then
                        If ws.Range("E3").Value = "All" Then
                                ws.Range("E4").Value = "All"
                        Else
                                ws.Range("E4").ClearContents
                        End If
                        Before = ws.Range("E3").Value
                End If

                Application.EnableEvents = True
        End If

        ' If E3 or E4 is changed, apply filtering
        If Not Intersect(Target, ws.Range("E3,E4")) Is Nothing Then
                Application.ScreenUpdating = False

                division = ws.Range("E3").Value
                site = ws.Range("E4").Value
                lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

                rowsVisible = False

                ' **Ensure all rows are unhidden first before filtering**
                ws.Rows("8:" & lastRow).Hidden = False

                ' Loop through data rows (starting from row 8)
                For Each cell In ws.Range("B8:B" & lastRow)
                        rowIndex = cell.Row

                        ' Default: Hide the row, unhide only if conditions match
                        ws.Rows(rowIndex).Hidden = True

                        ' Apply filtering logic
                        If division = "All" Then
                                ' Show all rows where Column C = 1
                                If ws.Cells(rowIndex, 3).Value = 1 Then
                                        If site = "All" Or ws.Cells(rowIndex, 6).Value = site Then
                                                ws.Rows(rowIndex).Hidden = False
                                                rowsVisible = True
                                        End If
                                End If
                        Else
                                ' Check if Column B matches the selected division & Column C = 1
                                If ws.Cells(rowIndex, 2).Value = division And ws.Cells(rowIndex, 3).Value = 1 Then
                                        If site = "All" Or ws.Cells(rowIndex, 6).Value = site Then
                                                ws.Rows(rowIndex).Hidden = False
                                                rowsVisible = True
                                        End If
                                End If
                        End If
                Next cell

                ' If no rows match, at least ensure headers remain visible
                ws.Rows("1:7").Hidden = False

                Application.ScreenUpdating = True
        End If
End Sub

第一段代码问题 #

1. 硬编码行号到909，数据超出后会遗漏行
2. E3和E4的处理逻辑完全重复，冗余度高
3. 未针对E3的"All"选项做适配，当E3选"All"时，B列公式应返回1，但代码逻辑未响应此场景

第二段代码问题 #

1. 错误地将ws.Cells(rowIndex, 2).Value = division作为判断条件，但B列存储的是1/0而非部门名称，导致部门筛选逻辑完全失效
2. 切换到"All"时，未确保B、C列公式已更新，基于旧值筛选导致结果错误
3. 筛选逻辑重复判断部门和站点名称，未复用已设置的B、C列辅助标记，增加出错概率

Option Explicit

Public BeforeDivision As Variant

Private Sub Worksheet_Activate()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    BeforeDivision = Me.Range("E3").Value
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic ' 激活工作表时恢复自动计算
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim division As String
    Dim site As String
    Dim rowIndex As Long
    
    Set ws = Me ' 用Me指代当前工作表，避免硬编码表名
    
    ' 强制保持表头可见
    ws.Rows("1:7").Hidden = False
    
    ' 处理E3变更时的E4联动逻辑
    If Not Intersect(Target, ws.Range("E3")) Is Nothing Then
        Application.EnableEvents = False
        Application.Calculation = xlCalculationAutomatic ' 先更新辅助列公式
        
        If ws.Range("E3").Value <> BeforeDivision Then
            If ws.Range("E3").Value = "All" Then
                ws.Range("E4").Value = "All"
            Else
                ws.Range("E4").ClearContents
            End If
            BeforeDivision = ws.Range("E3").Value
        End If
        
        Application.EnableEvents = True
    End If
    
    ' 仅在E3或E4变更时执行筛选
    If Not Intersect(Target, ws.Range("E3,E4")) Is Nothing Then
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationAutomatic ' 确保辅助列公式已更新
        
        division = ws.Range("E3").Value
        site = ws.Range("E4").Value
        lastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row ' 用数据列E判断最后一行更准确
        
        ' 先取消所有数据行的隐藏状态
        ws.Rows("8:" & lastRow).Hidden = False
        
        ' 根据辅助列标记执行筛选
        For rowIndex = 8 To lastRow
            Select Case True
                ' All部门+All站点：显示所有C列为1的行
                Case division = "All" And site = "All":
                    ws.Rows(rowIndex).Hidden = (ws.Cells(rowIndex, "C").Value <> 1)
                ' All部门+指定站点：显示所有C列为1的行（C列已包含站点匹配逻辑）
                Case division = "All" And site <> "All":
                    ws.Rows(rowIndex).Hidden = (ws.Cells(rowIndex, "C").Value <> 1)
                ' 指定部门+All站点：显示所有B列为1的行
                Case division <> "All" And site = "All":
                    ws.Rows(rowIndex).Hidden = (ws.Cells(rowIndex, "B").Value <> 1)
                ' 指定部门+指定站点：显示所有C列为1的行
                Case Else:
                    ws.Rows(rowIndex).Hidden = (ws.Cells(rowIndex, "C").Value <> 1)
            End Select
        Next rowIndex
        
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationManual ' 恢复手动计算以提升性能
    End If
End Sub

1. 复用辅助列逻辑：直接利用已设置的B、C列1/0标记，无需重复判断部门和站点名称，避免逻辑冲突
2. 动态行号：通过数据列E获取最后一行，避免硬编码导致的遗漏
3. 公式更新保障：触发变更时先切换到自动计算，确保辅助列公式已更新后再执行筛选
4. 联动逻辑优化：E3切换到"All"时自动设置E4为"All"，保持筛选逻辑一致
5. 性能优化：合理控制屏幕更新和计算模式，避免Excel卡顿

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