使用ComboBox筛选ListBox仅显示一行数据的VBA技术求助

你的代码核心问题在于处理筛选后的数据时，仅遍历了每个可见区域（Area），但没有遍历区域内的每一行，导致只提取了每个区域的第一行数据。以下是修复后的完整代码及关键说明：

修复后的完整代码 #

Option Explicit

Dim ws As Worksheet
Dim lrow As Long
Dim i As Long, j As Long, rowCount As Long

Private Sub UserForm_Initialize()
    ' 指定目标工作表
    Set ws = Sheet1

    ' 设置ListBox列数
    ListBox1.ColumnCount = 7

    Dim col As New Collection
    Dim itm As Variant

    With ws
        ' 获取C列最后一行
        lrow = .Range("C" & .Rows.Count).End(xlUp).Row
        
        ' 从C列创建唯一值集合
        On Error Resume Next
        For i = 2 To lrow
            col.Add .Range("C" & i).Value2, CStr(.Range("C" & i).Value2)
        Next i
        On Error GoTo 0
        
        ' 将唯一值添加到ComboBox
        For Each itm In col
           ComboBox1.AddItem itm
        Next itm
    End With
End Sub

Private Sub CommandButton1_Click()
    ' 若未选择ComboBox选项则退出
    If ComboBox1.ListIndex = -1 Then Exit Sub

    ' 清空ListBox
    ListBox1.Clear

    Dim DataRange As Range, rngArea As Range
    Dim DataSet As Variant

    With ws
        ' 移除现有筛选
        .AutoFilterMode = False
        
        ' 获取C列最后一行
        lrow = .Range("C" & .Rows.Count).End(xlUp).Row
        
        ' 按ComboBox值筛选C列
        With .Range("C1:C" & lrow)
            .AutoFilter Field:=1, Criteria1:=ComboBox1.Value
            
            On Error Resume Next
            Set DataRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
            On Error GoTo 0
        End With
        
        ' 检查是否有筛选结果
        If Not DataRange Is Nothing Then
            ' 统计所有符合条件的行数
            rowCount = 0
            For Each rngArea In DataRange.Areas
                rowCount = rowCount + rngArea.Rows.Count
            Next rngArea
            
            ' 定义数组大小以容纳所有行数据
            ReDim DataSet(1 To rowCount, 1 To 7)
            
            j = 1
            ' 遍历每个可见区域的每一行
            For Each rngArea In DataRange.Areas
                For i = 1 To rngArea.Rows.Count
                    ' 遍历A到G列（共7列），存入数组
                    For Dim colNum As Long = 1 To 7
                        DataSet(j, colNum) = rngArea.Cells(i, colNum).Value2
                    Next colNum
                    j = j + 1
                Next i
            Next rngArea
            
            ' 将数组数据加载到ListBox
            ListBox1.List = DataSet
        End If
        
        ' 移除筛选
        .AutoFilterMode = False
    End With
End Sub

关键修改点说明 #

1. 统计总行数：遍历所有可见区域，累加每个区域的行数，确保数组能容纳所有符合条件的数据行。
2. 嵌套循环遍历行：在遍历每个可见区域的外层循环下，新增内层循环遍历区域内的每一行，保证不会遗漏任何符合条件的数据。
3. 完整列赋值：对每一行的7列数据逐一赋值，确保ListBox的每一列都能对应到原工作表的A-G列数据。

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