如何在不修改Excel ListObject的前提下获取排序后的数据数组？

针对你遇到的ADO依赖设置、性能下降问题，同时要避免修改原ListObject导致命名范围失效，以下两种方案可以实现需求：

方案一：通过临时工作表获取排序后的数据 #

核心思路是将原表数据复制到隐藏的临时工作表，在副本上执行排序，再将结果存入数组，最后删除临时表，完全不影响原表状态。

修改后的完整代码：

Sub getSortedFilteredDataWithoutAlteringTable()
    Dim LO As ListObject
    Dim tempWs As Worksheet
    Dim sortedArr As Variant
    Dim dResult As New Scripting.Dictionary
    Dim arrHeaders As Variant
    
    Set LO = wsInputsDb.ListObjects("tblInputs")
    
    ' 存入表头
    arrHeaders = LO.HeaderRowRange.Value
    dResult.Add "headers", arrHeaders
    
    ' 创建隐藏临时工作表
    Set tempWs = ThisWorkbook.Worksheets.Add
    tempWs.Visible = xlSheetVeryHidden
    
    ' 复制原表的表头和数据到临时表
    LO.HeaderRowRange.Copy tempWs.Range("A1")
    LO.DataBodyRange.Copy tempWs.Range("A2")
    
    ' 在临时表执行排序（按"SubSection order"列升序，可按需调整排序字段、顺序）
    With tempWs.Sort
        .SortFields.Clear
        .SortFields.Add Key:=tempWs.Range("A1").CurrentRegion.Find("SubSection order").EntireColumn, _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange tempWs.Range("A1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
    
    ' 将排序后的完整数据（含表头）存入数组
    sortedArr = tempWs.Range("A1").CurrentRegion.Value
    ' 若只需数据体，替换为：
    ' sortedArr = tempWs.Range("A2").Resize(tempWs.Cells(tempWs.Rows.Count, "A").End(xlUp).Row - 1, LO.ListColumns.Count).Value
    
    ' 存入字典
    dResult.Add "sorted_data", sortedArr
    
    ' 清理临时表
    Application.DisplayAlerts = False
    tempWs.Delete
    Application.DisplayAlerts = True
    
    ' 示例：输出数据到立即窗口
    Dim i As Long
    For i = LBound(sortedArr, 1) To UBound(sortedArr, 1)
        Debug.Print Join(Application.Index(sortedArr, i, 0), vbTab)
    Next i
End Sub

方案二：直接获取筛选后的可见数据 #

如果仅需要提取已筛选的可见数据，无需额外排序，可以直接利用SpecialCells(xlCellTypeVisible)，处理非连续区域为连续数组：

Sub getFilteredVisibleData()
    Dim LO As ListObject
    Dim visibleRng As Range
    Dim tempArr As Variant
    Dim resultArr() As Variant
    Dim rngArea As Range
    Dim i As Long, rowCount As Long, colCount As Long
    Dim dResult As New Scripting.Dictionary
    Dim arrHeaders As Variant
    
    Set LO = wsInputsDb.ListObjects("tblInputs")
    arrHeaders = LO.HeaderRowRange.Value
    dResult.Add "headers", arrHeaders
    
    ' 获取筛选后的可见数据体
    On Error Resume Next
    Set visibleRng = LO.DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If visibleRng Is Nothing Then
        Debug.Print "无可见数据"
        Exit Sub
    End If
    
    ' 统计可见区域的总行数
    rowCount = 0
    For Each rngArea In visibleRng.Areas
        rowCount = rowCount + rngArea.Rows.Count
    Next rngArea
    colCount = LO.ListColumns.Count
    
    ' 初始化结果数组
    ReDim resultArr(1 To rowCount, 1 To colCount)
    
    ' 遍历每个非连续区域，填充数组
    i = 1
    For Each rngArea In visibleRng.Areas
        tempArr = rngArea.Value
        Dim j As Long
        For j = 1 To UBound(tempArr, 1)
            resultArr(i, 1 To colCount) = tempArr(j, 1 To colCount)
            i = i + 1
        Next j
    Next rngArea
    
    ' 存入字典
    dResult.Add "filtered_data", resultArr
    
    ' 示例：输出数据到立即窗口
    For i = LBound(resultArr, 1) To UBound(resultArr, 1)
        Debug.Print Join(Application.Index(resultArr, i, 0), vbTab)
    Next i
End Sub

关键说明 #

• 临时表方案完全隔离原表操作，不会改变原表的排序状态、命名范围引用，同时支持任意排序规则；
• 可见数据方案直接读取筛选结果，性能优于ADO，且无需额外依赖设置；
• 两种方案均保留了你原代码中用Scripting.Dictionary存储数据的逻辑，可直接集成到现有流程中。

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