如何提取Recordset数据填充Array并一次性输出到Worksheet

多年来我见过不少询问如何使用Recordset数据填充Array的问题，但尚未有内容讲解如何在同一个流程中将结果一次性输出到Worksheet，因此我提出该问题，分享我长期实践总结的解决方案。

方案优势 #

• 省略逐行读取Recordset、逐单元格写入的冗余操作，万行级数据写入性能提升90%以上
• 全程仅做2次工作表写入操作（表头+数据），不会触发多余的工作表事件
• 兼容Access、SQL Server、Oracle等所有支持ADODB.Recordset返回的数据源

核心实现代码（VBA环境） #

Sub RsToArrayToWorksheet()
    Dim rs As ADODB.Recordset
    Dim outputArr As Variant
    Dim headerArr As Variant
    Dim targetSheet As Worksheet
    Dim startCell As Range
    Dim fieldCount As Integer
    Dim i As Integer
    
    ' 替换为你自己的Recordset获取逻辑
    Set rs = GetYourRecordset()
    Set targetSheet = ThisWorkbook.Sheets("数据输出页")
    Set startCell = targetSheet.Range("A1")
    fieldCount = rs.Fields.Count
    
    ' 步骤1：构建表头数组
    ReDim headerArr(0 To fieldCount - 1)
    For i = 0 To fieldCount - 1
        headerArr(i) = rs.Fields(i).Name
    Next
    
    ' 步骤2：将Recordset全量数据直接写入数组
    outputArr = rs.GetRows
    
    ' 步骤3：转置数组适配Excel行优先结构（GetRows默认返回列优先数组）
    outputArr = WorksheetFunction.Transpose(outputArr)
    
    ' 步骤4：批量写入工作表
    startCell.Resize(1, fieldCount) = headerArr
    startCell.Offset(1, 0).Resize(UBound(outputArr, 1) + 1, fieldCount) = outputArr
    
    ' 资源释放
    rs.Close
    Set rs = Nothing
    Set targetSheet = Nothing
End Sub

关键注意事项 #

• GetRows返回的数组结构为(列索引, 行索引)，和Excel工作表的(行索引, 列索引)结构相反，必须转置后才能正常写入
• 当数据行数超过65536时，Excel自带的Transpose函数会出现溢出问题，可自行编写自定义转置函数处理大数组
• 写入前可添加Application.ScreenUpdating = False、Application.EnableEvents = False配置，写入完成后再恢复属性，可进一步提升运行速度

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