Excel VBA 遍历行并隐藏不包含数组指定值的实现方法问询

• 核心逻辑错误：每处理一个复选框就直接覆盖行的隐藏状态，最终只有最后一个勾选的复选框的判断结果会生效，完全无法实现「只要匹配任意一个勾选值就显示」的需求
• 性能损耗严重：14个复选框对应14次全量遍历3000行数据，反复操作单元格隐藏属性会触发频繁的屏幕刷新，运行时卡顿明显
• 代码规范问题：所有变量未显式声明类型，默认是Variant变体类型，容易出现意料之外的类型匹配错误
• 冗余无效逻辑：未勾选复选框的分支中，无论单元格内容是否匹配都强制设置行为显示，属于完全无用的代码块

实现思路：先收集所有勾选的目标匹配值，仅遍历一次数据行，统一判断当前行内容是否符合筛选规则，同时关闭屏幕更新等功能降低性能开销。

Option Explicit ' 强制变量声明，避免类型错误
Private Sub FilterResults_Click()
    ' 常量定义，统一修改入口
    Const CB_START As Integer = 2
    Const CB_END As Integer = 15
    Const START_ROW As Long = 2
    Const END_ROW As Long = 2999
    Const COL_NUM As Integer = 7
    
    Dim SubProduct() As Variant
    Dim selectedProducts As Collection
    Dim i As Integer, j As Long
    Dim prod As Variant
    Dim isMatch As Boolean
    
    SubProduct = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
    Set selectedProducts = New Collection
    
    ' 第一步：先收集所有勾选的目标值
    For i = CB_START To CB_END
        If UserForm1.Controls("CheckBox" & i).Value = True Then
            selectedProducts.Add SubProduct(i - CB_START) ' 复选框索引和数组索引对应
        End If
    Next i
    
    ' 关闭屏幕更新和事件，提升运行效率
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' 错误捕获，避免异常导致屏幕更新一直关闭
    On Error GoTo ErrHandler
    
    ' 第二步：仅遍历一次数据行判断是否匹配
    For j = START_ROW To END_ROW
        isMatch = False
        ' 判断当前行内容是否匹配任意一个选中的目标值
        For Each prod In selectedProducts
            ' 如需不区分大小写匹配，可将vbBinaryCompare改为vbTextCompare
            If InStr(1, Cells(j, COL_NUM).Value, prod, vbBinaryCompare) > 0 Then
                isMatch = True
                Exit For ' 匹配到就跳出循环，减少无效判断
            End If
        Next prod
        
        ' 统一设置隐藏状态：匹配到任意选中值则显示，否则隐藏
        ' 如无勾选值时要全部隐藏，可把selectedProducts.Count = 0的判断去掉
        Cells(j, COL_NUM).EntireRow.Hidden = Not (isMatch Or selectedProducts.Count = 0)
    Next j
    
    UserForm1.Hide
    
ErrHandler:
    ' 恢复Excel设置，无论是否报错都执行
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    If Err.Number <> 0 Then
        MsgBox "筛选出错：" & Err.Description, vbCritical
    End If
End Sub

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