合并85个Excel工作表指定范围数据到总表的VBA方案咨询

需求说明 #

共85个工作表，每个工作表需提取I12:N42范围内的内容，该范围包含公式与单元格引用，具体要求：

• 过滤掉范围内所有Qty = 0的行
• 提取结果仅粘贴数值到名为master的总表中

补充说明：此前使用Power Query实现速度过慢，需要VBA方案提升运行效率

VBA实现代码 #

全程采用数组处理，避免逐单元格操作，运行效率远高于普通复制粘贴方案：

Sub ExtractDataToMaster()
    Dim ws As Worksheet, masterWs As Worksheet
    Dim sourceArr, tempArr
    Dim i As Long, j As Long, rowCnt As Long, qtyCol As Long
    Dim pasteStart As Range
    
    ' 关闭冗余功能提速
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' 初始化总表
    On Error Resume Next
    Set masterWs = ThisWorkbook.Sheets("master")
    On Error GoTo 0
    If masterWs Is Nothing Then
        Set masterWs = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
        masterWs.Name = "master"
    Else
        masterWs.UsedRange.Clear
    End If
    
    ' 配置参数：Qty在提取范围I:N的第几列，I为第1列、J为第2列，以此类推，根据实际调整
    qtyCol = 1
    
    ' 遍历所有工作表
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> "master" Then
            ' 读取源区域到数组
            sourceArr = ws.Range("I12:N42").Value
            ReDim tempArr(1 To UBound(sourceArr, 1), 1 To 6)
            rowCnt = 0
            
            ' 过滤Qty=0的行
            For i = 1 To UBound(sourceArr, 1)
                If sourceArr(i, qtyCol) <> 0 Then
                    rowCnt = rowCnt + 1
                    For j = 1 To 6
                        tempArr(rowCnt, j) = sourceArr(i, j)
                    Next j
                End If
            Next i
            
            ' 批量写入总表
            If rowCnt > 0 Then
                Set pasteStart = masterWs.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                pasteStart.Resize(rowCnt, 6).Value = tempArr
            End If
        End If
    Next ws
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "处理完成，共提取有效数据" & masterWs.UsedRange.Rows.Count - 1 & "行"
End Sub

使用步骤 #

1. 打开目标Excel文件，按Alt+F11打开VBA编辑器，右键点击工程名选择「插入」-「模块」
2. 将上述代码粘贴到模块中，调整qtyCol参数为Qty字段在I12:N42范围内的对应列序
3. 按F5运行代码即可，运行完成后自动弹出结果提示

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