我是VBA的新手，目前正在制作一个用户表单，根据组合框值过滤所有数据，该组合框值可以工作，但只提取1行数据，而不是具有相同单元格值的所有行，即C列。
我尝试让它在C列中搜索组合框条件，并在列表框中显示具有相同单元格值的所有行。

Option Explicit

 Dim ws As Worksheet
 Dim lrow As Long
 Dim i As Long, j As Long
 Private Sub UserForm_Initialize()

 '~~> Set this to the relevant worksheet
 Set ws = Sheet1

 '~~> Set the listbox column count
 ListBox1.ColumnCount = 7

 Dim col As New Collection
 Dim itm As Variant

 With ws
    '~~> Get last row in column C
    lrow = .Range("C" & .Rows.Count).End(xlUp).Row
    
    '~~> Create a unique list from column C values
    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
    
    '~~> Add the item to combobox
    For Each itm In col
       ComboBox1.AddItem itm
    Next itm
 End With
 End Sub

 Private Sub CommandButton1_Click()
 '~~> If nothing selected in the combobox then exit
  If ComboBox1.ListIndex = -1 Then Exit Sub

'~~> Clear the listbox
ListBox1.Clear

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

With ws
    '~~> Remove any filters
    .AutoFilterMode = False
    
    '~~> Find last row in Col C
    lrow = .Range("C" & .Rows.Count).End(xlUp).Row
    
    '~~> Filter on the relevant column
    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
    
    '~~> Check if the autofilter returned any results
    If Not DataRange Is Nothing Then
        '~~> Instead of using another object, I am reusing the object
        Set DataRange = .Range("A2:G" & lrow).SpecialCells(xlCellTypeVisible)
        
        '~~> Create the array
        ReDim DataSet(1 To DataRange.Areas.Count + 1, 1 To 7)
        
        j = 1
        
        '~~> Loop through the area and store in the array
        For Each rngArea In DataRange.Areas
            For i = 1 To 7
                DataSet(j, i) = rngArea.Cells(, i).Value2
            Next i
            j = j + 1
        Next rngArea
        
        '~~> Set the listbox list
        ListBox1.List = DataSet
    End If
    
    '~~> Remove any filters
    .AutoFilterMode = False
    End With
 End Sub