如何用VBA数组处理Excel数据并写入另一工作簿以提升效率

你的思路完全正确——直接操作Excel对象模型（比如Select、Copy/Paste、工作表内筛选排序）是导致宏运行缓慢的核心原因，将数据加载到内存数组中处理，能把运行时间从分钟级压缩到秒级。

以下是优化后的完整代码，同时解决你提到的筛选第3列错误行、按指定规则排序、写入模板三个问题：

Sub CreateDailySheet_Optimized()
    Dim wbMaster As Workbook, wbTemplate As Workbook
    Dim wsMaster As Worksheet, wsTemplate As Worksheet
    Dim tblMaster As ListObject, tblTemplate As ListObject
    Dim rawData As Variant, filteredData As Variant
    Dim criteriaArr As Variant
    Dim i As Long, j As Long, outputRow As Long
    Dim tempWs As Worksheet
    
    '===== 基础优化：关闭Excel交互提升速度 =====
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    '===== 初始化对象：避免Activate/Select =====
    Set wbMaster = ThisWorkbook
    Set wsMaster = wbMaster.ActiveSheet '可替换为指定工作表，比如wsMaster = wbMaster.Sheets("主数据")
    Set tblMaster = wsMaster.ListObjects("MAIN")
    criteriaArr = Array("DA", "DB", "E1", "E2", "FF", "FG", "G1", "GA", "GS", "I0", "I2", "IK", "IX")
    
    '===== 加载原始数据到内存数组 =====
    rawData = tblMaster.DataBodyRange.Value '仅加载表格数据区域，不含表头
    
    '===== 筛选数据：剔除第3列错误行 + 保留第7列符合条件的行 =====
    '先统计符合条件的行数
    outputRow = 0
    For i = LBound(rawData, 1) To UBound(rawData, 1)
        '检查第3列是否为错误值，且第7列是否在筛选列表中
        If Not IsError(rawData(i, 3)) And IsInArray(rawData(i, 7), criteriaArr) Then
            outputRow = outputRow + 1
        End If
    Next i
    
    '创建筛选后数组
    ReDim filteredData(1 To outputRow, 1 To UBound(rawData, 2))
    outputRow = 0
    For i = LBound(rawData, 1) To UBound(rawData, 1)
        If Not IsError(rawData(i, 3)) And IsInArray(rawData(i, 7), criteriaArr) Then
            outputRow = outputRow + 1
            For j = 1 To UBound(rawData, 2)
                filteredData(outputRow, j) = rawData(i, j)
            Next j
        End If
    Next i
    
    '===== 数组排序：利用临时工作表完成多条件排序 =====
    If outputRow > 0 Then
        Set tempWs = wbMaster.Sheets.Add
        '写入临时工作表
        tempWs.Range("A1").Resize(outputRow, UBound(filteredData, 2)).Value = filteredData
        '设置排序规则（对应原宏的5个排序条件，需替换为实际列位置）
        With tempWs.Sort
            .SortFields.Clear
            'RIM列：替换为原始数据中RIM对应的列号/列标
            .SortFields.Add Key:=tempWs.Columns("RIM列位置"), Order:=xlAscending
            'PROFILE列：替换为原始数据中PROFILE对应的列号/列标
            .SortFields.Add Key:=tempWs.Columns("PROFILE列位置"), Order:=xlDescending
            'SECTION列：替换为原始数据中SECTION对应的列号/列标
            .SortFields.Add Key:=tempWs.Columns("SECTION列位置"), Order:=xlAscending
            'LOAD & SPEED INDEX列：替换为原始数据中对应列号/列标
            .SortFields.Add Key:=tempWs.Columns("LOAD& SPEED INDEX列位置"), Order:=xlAscending
            'PRODUCT GROUP列：替换为原始数据中对应列号/列标
            .SortFields.Add Key:=tempWs.Columns("PRODUCT GROUP列位置"), Order:=xlDescending
            .SetRange tempWs.Range("A1").Resize(outputRow, UBound(filteredData, 2))
            .Header = xlNo '临时表无表头
            .Apply
        End With
        '把排序后的数据读回数组
        filteredData = tempWs.Range("A1").Resize(outputRow, UBound(filteredData, 2)).Value
        '删除临时工作表
        Application.DisplayAlerts = False
        tempWs.Delete
        Application.DisplayAlerts = True
    End If
    
    '===== 打开模板并写入数据 =====
    Set wbTemplate = Workbooks.Open("O:\GLOBAL\JACK\Pricing\Trial\Templates\DERIVED TEMPLATE.xlsx")
    Set wsTemplate = wbTemplate.Worksheets("D0-FZ")
    Set tblTemplate = wsTemplate.ListObjects("Table1")
    
    '清空模板表格原有数据（保留表头）
    If Not tblTemplate.DataBodyRange Is Nothing Then
        tblTemplate.DataBodyRange.Delete
    End If
    
    '写入筛选排序后的数据
    If outputRow > 0 Then
        tblTemplate.ListRows.Add AlwaysInsert:=False
        tblTemplate.DataBodyRange.Resize(outputRow, UBound(filteredData, 2)).Value = filteredData
    End If
    
    '===== 保存并关闭新文件 =====
    wbTemplate.SaveAs Filename:= _
        "O:\GLOBAL\JACK\Pricing\Trial\DERIVED " & Format(Now(), "DD-MM-YY") & ".XLSX", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    
    wbTemplate.Close SaveChanges:=False
    
    '===== 恢复Excel设置 =====
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
    '清除原表格筛选
    tblMaster.Range.AutoFilter Field:=7
End Sub

'辅助函数：检查值是否在目标数组中
Function IsInArray(searchVal As Variant, arr As Variant) As Boolean
    Dim val As Variant
    For Each val In arr
        If val = searchVal Then
            IsInArray = True
            Exit Function
        End If
    Next val
    IsInArray = False
End Function

关键优化点说明 #

• 彻底避免Activate/Select：原代码频繁切换窗口、选择单元格是核心耗时点，优化后直接通过对象变量引用工作簿、工作表和表格，完全消除交互操作。
• 内存数组处理：从结构化表格ListObject的DataBodyRange加载数据，比UsedRange更精准；遍历数组完成筛选，速度远快于工作表内的AutoFilter。
• 多条件排序实现：VBA无内置多维数组多条件排序函数，采用临时工作表中转——将数组写入临时表后用Excel内置排序完成规则，再读回数组，代码简洁且高效。
• 直接写入模板表格：通过ListObject.DataBodyRange.Value将数组直接写入模板的结构化表格，避免复制粘贴，同时保留模板公式列的正常计算。
• 基础性能优化：关闭屏幕更新、事件触发和自动计算，减少Excel后台操作开销。

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