在VBA用户窗体中用ComboBox筛选ListBox的技术求助

1. 核心修改思路 #

原代码直接用RowSource加载整个数据区域，无法实现动态筛选。我们改成遍历数据行+条件判断，只把符合筛选条件的行添加到列表框；同时保留空筛选时显示全部数据的功能。

2. 完整修改代码 #

下拉框筛选事件代码（cmbFilter_Change）

Private Sub cmbFilter_Change()
    Dim sh As Worksheet
    Dim lr As Long
    Dim i As Long
    
    Set sh = ThisWorkbook.Sheets("Input")
    ' 以J列（筛选列）为准，获取最后一行数据行号
    lr = sh.Cells(Rows.Count, "J").End(xlUp).Row
    If lr < 2 Then lr = 2 ' 处理无数据的边界情况
    
    With Me.ListBox1
        .Clear ' 每次筛选前清空列表框，避免重复内容
        .ColumnCount = 9
        .ColumnWidths = "30,40,150,60,60,180,50,0,80"
        .ColumnHeads = True ' 保持显示表头
        
        ' 情况1：筛选框为空，显示全部数据
        If Trim(Me.cmbFilter.Value) = "" Then
            .RowSource = "Input!B2:J" & lr
        ' 情况2：有筛选条件，遍历行筛选匹配数据
        Else
            For i = 2 To lr
                ' 匹配J列值（Trim用于去除前后空格，避免因空格导致的匹配失败）
                If Trim(sh.Cells(i, "J").Value) = Trim(Me.cmbFilter.Value) Then
                    ' 逐列添加当前行数据到列表框
                    .AddItem sh.Cells(i, "B").Value ' 第1列（B列）
                    .List(.ListCount - 1, 1) = sh.Cells(i, "C").Value ' 第2列（C列）
                    .List(.ListCount - 1, 2) = sh.Cells(i, "D").Value ' 第3列（D列）
                    .List(.ListCount - 1, 3) = sh.Cells(i, "E").Value ' 第4列（E列）
                    .List(.ListCount - 1, 4) = sh.Cells(i, "F").Value ' 第5列（F列）
                    .List(.ListCount - 1, 5) = sh.Cells(i, "G").Value ' 第6列（G列）
                    .List(.ListCount - 1, 6) = sh.Cells(i, "H").Value ' 第7列（H列）
                    .List(.ListCount - 1, 7) = sh.Cells(i, "I").Value ' 第8列（I列）
                    .List(.ListCount - 1, 8) = sh.Cells(i, "J").Value ' 第9列（J列）
                End If
            Next i
            
            ' 可选：如果没有匹配数据，显示提示
            If .ListCount = 0 Then .AddItem "无匹配数据"
        End If
    End With
End Sub

用户窗体初始化代码（UserForm_Initialize）

为了避免手动输入筛选值出错，我们可以在窗体打开时，自动把J列的唯一值加载到下拉框中：

Private Sub UserForm_Initialize()
    Dim sh As Worksheet
    Dim lr As Long
    Dim i As Long
    Dim uniqueVals As Collection
    
    Set sh = ThisWorkbook.Sheets("Input")
    lr = sh.Cells(Rows.Count, "J").End(xlUp).Row
    
    ' 收集J列的唯一值（避免重复选项）
    Set uniqueVals = New Collection
    On Error Resume Next ' 遇到重复值时忽略错误
    For i = 2 To lr
        If Trim(sh.Cells(i, "J").Value) <> "" Then
            uniqueVals.Add sh.Cells(i, "J").Value, Key:=CStr(sh.Cells(i, "J").Value)
        End If
    Next i
    On Error GoTo 0 ' 恢复错误捕获
    
    ' 将唯一值添加到下拉框，同时保留空选项（用于显示全部）
    Me.cmbFilter.AddItem ""
    For i = 1 To uniqueVals.Count
        Me.cmbFilter.AddItem uniqueVals(i)
    Next i
    
    ' 初始化列表框，默认显示全部数据
    With Me.ListBox1
        .ColumnCount = 9
        .ColumnWidths = "30,40,150,60,60,180,50,0,80"
        .ColumnHeads = True
        .RowSource = "Input!B2:J" & lr
    End With
End Sub

3. 关键说明 #

• 清空列表框：每次筛选前用.Clear清空，防止旧数据残留。
• 边界处理：判断lr < 2，避免没有数据时出现错误。
• 空格处理：用Trim()去除字符串前后空格，解决因空格导致的匹配失败问题。
• 唯一值下拉框：通过Collection收集J列唯一值，让用户只能选择已有选项，减少错误输入。

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