如何利用SpecialCells(xlCellTypeVisible)遍历筛选后ListObject的行

我有一个包含5列数据的Excel表格（ListObject），需要根据条件筛选数据，然后遍历筛选后的每一行，提取第2、3列的数据填充表单上的列表框。目前我只能通过遍历SpecialCells(xlCellTypeVisible)引用的每个单元格，用计数器来获取所需数据，这种方法很繁琐。有没有更高效的方式处理SpecialCells(xlCellTypeVisible)来实现需求？

原代码如下：

Public Sub PopulateListBox()
    Dim ws As Worksheet
    Dim lstObj As ListObject
    Dim rngResults As Range
    Dim strFilter As String
    Dim intCount As Integer
    Dim strLocation As String
    Dim strTelNo As String
    
    Set ws = ThisWorkbook.Worksheets("Location Data")
    Set lstObj = ws.ListObjects(1)
    
    If lstObj.ShowAutoFilter Then
        lstObj.ShowAutoFilter = False
    End If
    
    'Filter the list by the name of an option on Form.  
    'Simplified the code here so the Form isn't 'required.
    
    'strFilter = tsRegion.SelectedItem.Caption   'Requires the UserForm to run so hardcoded here.

    strFilter = "North East"                     'to "North East" for this example.
    
    With lstObj.Range 'Filter by the filter value selected on the form.
        .AutoFilter Field:=5, Criteria1:=strFilter
    End With
    
    'Loop through all 5 columns in the table and add the values of the 2 columns 
    'needed as an entry on a list box on a userform
    intCount = 1
    For Each rngResults In lstObj.DataBodyRange.SpecialCells(xlCellTypeVisible)
        '########################################
        'This 'works' but feels really clunky.
        'Ideally would a way to loop through all visible rows, not individual cells
        'It also needs a tweak to skipped the header row
        '########################################
        
        Select Case intCount
            Case 2 'data from 2nd column of table
                strLocation = rngResults.Value
            Case 3 'data from 3rd column of table
                strTelNo = rngResults.Value
            Case 5
              'Commented out the code below for this example as it is populating
              'a listbox on a UserForm. It works but simplified for this example.
              'Changed it to output to the debug window instead.
              ' With Me.lstBox   'A list box on a UserForm.
                  '  .AddItem
                  '  .List(intRowCount, 0) = strLocation
                   ' .List(intRowCount, 1) = strTelNo
              ' End With
              Debug.Print strLocation, strTelNo
              intCount = 0
        End Select
        intCount = intCount + 1
    Next
End Sub

方案1：直接遍历可见行（简洁直观） #

筛选后的可见区域可能由多个不连续区块组成，用Areas遍历每个区块，再逐行提取第2、3列的值，完全避免单元格级别的循环：

Public Sub PopulateListBox_Efficient()
    Dim ws As Worksheet
    Dim lstObj As ListObject
    Dim strFilter As String
    Dim visibleArea As Range
    Dim rowRange As Range
    
    Set ws = ThisWorkbook.Worksheets("Location Data")
    Set lstObj = ws.ListObjects(1)
    
    ' 关闭现有筛选（如果存在）
    If lstObj.ShowAutoFilter Then lstObj.ShowAutoFilter = False
    
    ' 设置筛选条件
    strFilter = "North East"
    lstObj.Range.AutoFilter Field:=5, Criteria1:=strFilter
    
    ' 捕获可见数据区域，处理无匹配结果的情况
    On Error Resume Next
    Set visibleArea = lstObj.DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not visibleArea Is Nothing Then
        ' 遍历每个不连续的可见区块
        For Each visibleArea In visibleArea.Areas
            ' 遍历区块内的每一行
            For Each rowRange In visibleArea.Rows
                ' 直接提取当前行的第2、3列值
                Debug.Print rowRange.Cells(1, 2).Value, rowRange.Cells(1, 3).Value
                
                ' 填充列表框的代码（取消注释即可使用）
                ' With Me.lstBox
                '     .AddItem rowRange.Cells(1, 2).Value
                '     .List(.ListCount - 1, 1) = rowRange.Cells(1, 3).Value
                ' End With
            Next rowRange
        Next visibleArea
    End If
    
    ' 可选：清除筛选恢复原始数据
    lstObj.AutoFilter.ShowAllData
End Sub

方案2：通过列名引用（增强可维护性） #

如果表格有明确的表头，直接用列名定位目标列，避免依赖固定列索引，后续表格结构调整时无需修改代码：

Public Sub PopulateListBox_ByColumnName()
    Dim ws As Worksheet
    Dim lstObj As ListObject
    Dim strFilter As String
    Dim visibleArea As Range
    Dim rowRange As Range
    Dim colLocation As ListColumn, colTelNo As ListColumn
    
    Set ws = ThisWorkbook.Worksheets("Location Data")
    Set lstObj = ws.ListObjects(1)
    ' 替换为你的表格第2、3列实际表头名
    Set colLocation = lstObj.ListColumns("Location")
    Set colTelNo = lstObj.ListColumns("TelNo")
    
    ' 关闭现有筛选
    If lstObj.ShowAutoFilter Then lstObj.ShowAutoFilter = False
    
    ' 设置筛选条件
    strFilter = "North East"
    lstObj.Range.AutoFilter Field:=5, Criteria1:=strFilter
    
    ' 捕获可见数据区域
    On Error Resume Next
    Set visibleArea = lstObj.DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not visibleArea Is Nothing Then
        For Each visibleArea In visibleArea.Areas
            For Each rowRange In visibleArea.Rows
                ' 通过列对象获取对应行的值
                Debug.Print colLocation.DataBodyRange.Cells(rowRange.Row - lstObj.HeaderRowRange.Row, 1).Value, _
                            colTelNo.DataBodyRange.Cells(rowRange.Row - lstObj.HeaderRowRange.Row, 1).Value
                
                ' 填充列表框的代码
                ' With Me.lstBox
                '     .AddItem colLocation.DataBodyRange.Cells(rowRange.Row - lstObj.HeaderRowRange.Row, 1).Value
                '     .List(.ListCount - 1, 1) = colTelNo.DataBodyRange.Cells(rowRange.Row - lstObj.HeaderRowRange.Row, 1).Value
                ' End With
            Next rowRange
        Next visibleArea
    End If
    
    lstObj.AutoFilter.ShowAllData
End Sub

方案3：数组批量处理（大数据场景最优） #

如果数据量较大，将目标列的可见数据存入数组，批量处理后再输出/填充，大幅减少与Excel单元格的交互次数，提升运行效率：

Public Sub PopulateListBox_Array()
    Dim ws As Worksheet
    Dim lstObj As ListObject
    Dim strFilter As String
    Dim visibleCols As Range
    Dim dataArr As Variant
    Dim resultArr() As String
    Dim i As Long, rowIndex As Long
    
    Set ws = ThisWorkbook.Worksheets("Location Data")
    Set lstObj = ws.ListObjects(1)
    
    ' 关闭现有筛选
    If lstObj.ShowAutoFilter Then lstObj.ShowAutoFilter = False
    
    ' 设置筛选条件
    strFilter = "North East"
    lstObj.Range.AutoFilter Field:=5, Criteria1:=strFilter
    
    ' 合并第2、3列的可见区域
    On Error Resume Next
    Set visibleCols = Union(lstObj.ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible), _
                           lstObj.ListColumns(3).DataBodyRange.SpecialCells(xlCellTypeVisible))
    On Error GoTo 0
    
    If Not visibleCols Is Nothing Then
        ' 将可见区域数据存入数组
        dataArr = visibleCols.Value
        ' 初始化结果数组（行数为可见行数，列数固定为2）
        ReDim resultArr(1 To UBound(dataArr) / 2, 1 To 2)
        
        rowIndex = 1
        ' 遍历数组提取第2、3列配对数据
        For i = 1 To UBound(dataArr) Step 2
            resultArr(rowIndex, 1) = dataArr(i, 1)
            resultArr(rowIndex, 2) = dataArr(i + 1, 1)
            rowIndex = rowIndex + 1
        Next i
        
        ' 批量输出到调试窗口
        For i = 1 To UBound(resultArr)
            Debug.Print resultArr(i, 1), resultArr(i, 2)
        Next i
        
        ' 批量填充列表框（需提前将列表框ColumnCount设为2）
        ' With Me.lstBox
        '     .Clear
        '     .ColumnCount = 2
        '     .List = resultArr
        ' End With
    End If
    
    lstObj.AutoFilter.ShowAllData
End Sub

核心优化点 #

• 跳过单元格级循环，直接遍历行，代码逻辑更清晰
• 用Areas处理筛选后的不连续区域，避免遗漏数据
• 数组方式减少Excel对象交互，大数据场景下效率提升明显
• 支持按列名引用，降低后续维护成本

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