筛选数据集无法完整显示在ListBox中的VBA问题求助

你的代码核心问题是：筛选后的可见区域是不连续的多个子区域（Areas），直接用filteredRange.Rows.Count只能获取第一个子区域的行数，后续子区域的行不会被统计，导致数组容量不足，遍历到超出第一个区域的行时就会停止，因此只显示部分数据。

下面是修正后的完整代码：

Private Sub UserForm_Initialize()
    On Error GoTo ErrorHandler
    
    ListBox1.Clear
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Janes Tab")
    Dim rng As Range
    Set rng = ws.Range("A8:BR15000") 'A8是表头行，数据从A9开始
    
    '获取真实的可见数据行（跳过表头）
    Dim filteredRange As Range
    On Error Resume Next '如果没有可见行，SpecialCells会报错，先捕获
    Set filteredRange = rng.Offset(1).SpecialCells(xlCellTypeVisible) '从A9开始取可见行
    On Error GoTo ErrorHandler
    
    If filteredRange Is Nothing Then
        MsgBox "没有可见数据行", vbInformation
        Exit Sub
    End If
    
    '统计可见列数
    Dim visibleColumnCount As Long
    Dim columnIndex As Long
    For columnIndex = 1 To rng.Columns.Count
        If Not rng.Columns(columnIndex).Hidden Then
            visibleColumnCount = visibleColumnCount + 1
        End If
    Next columnIndex
    
    '统计总行数（遍历所有Area）
    Dim totalVisibleRows As Long
    Dim area As Range
    For Each area In filteredRange.Areas
        totalVisibleRows = totalVisibleRows + area.Rows.Count
    Next area
    
    '初始化存储数据的数组
    Dim rowData() As Variant
    ReDim rowData(1 To totalVisibleRows, 1 To visibleColumnCount)
    
    '填充数组：遍历每个Area的每一行
    Dim rowIndex As Long
    rowIndex = 1
    Dim currentRow As Range
    Dim visibleColIdx As Long
    
    For Each area In filteredRange.Areas
        For Each currentRow In area.Rows
            visibleColIdx = 1
            For columnIndex = 1 To rng.Columns.Count
                If Not rng.Columns(columnIndex).Hidden Then
                    rowData(rowIndex, visibleColIdx) = currentRow.Cells(1, columnIndex).Value
                    visibleColIdx = visibleColIdx + 1
                End If
            Next columnIndex
            rowIndex = rowIndex + 1
        Next currentRow
    Next area
    
    '赋值给ListBox
    ListBox1.List = rowData
    ListBox1.ColumnWidths = "20;50;40;20;20;450;50;40;20;20;20;50;40;20;20"
    
    '清除筛选
    ws.AutoFilterMode = False
    
    Exit Sub

ErrorHandler:
    MsgBox "错误: " & Err.Description, vbExclamation
End Sub

关键修正点 #

• 正确统计可见行数：遍历filteredRange.Areas，累加每个子区域的行数，得到真实的总可见行数
• 遍历可见行：通过For Each area In filteredRange.Areas和For Each currentRow In area.Rows，逐个处理每个不连续区域的行，避免索引越界
• 错误处理优化：添加了对“无可见行”情况的判断，防止SpecialCells报错
• 数据读取逻辑：直接从当前行currentRow读取列数据，确保每个可见行的所有可见列都被正确收集

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