多Excel工作簿数据提取编译问题及VBA优化咨询

问题背景 #

需要将多个Excel工作簿的列数据提取到汇总文件用于绘图，当前遇到两个核心问题：

• 现有数据引用仅在源工作簿打开时生效，关闭后公式失效
• 曾尝试通过VBA打开文件复制值，但速度极慢且偶尔无法运行，即使使用完整路径和Dir()函数也无改善

当前使用的VBA代码运行速度较快，但同样依赖源文件处于打开状态，寻求最优提取方案。

当前使用的VBA代码 #

Sub hente_inn_celleverdier_original()
'文件名列表位置：(165 + i, 8)（即H166及以下单元格）*编辑：之前写错单元格地址为G166，现已修正...*
'目标文件中，EP23和EQ23为对应列中排除空值等后的有效单元格数量
'(7, 263 + 2 * i [= 265]) 是汇总文件中待填充表格的左上角单元格…
Application.ScreenUpdating = False
For i = 1 To 38 '=系列数量（即需要提取数据的文件数量）

Debug.Print (Cells(165 + i, 8)) ' 打印文件名（不含.xlsx后缀）
A = Workbooks(Cells(165 + i, 8) & ".xlsx").Sheets(1).Range("EP23")
Debug.Print A' 打印EP23单元格中的数值
Cells(7, 263 + 2 * i).Value2 = "='[" & Cells(165 + i, 8) & ".xlsx]CPTU'!EP28"
Cells(7, 263 + 2 * i).Select
Selection.AutoFill Destination:=Range(Cells(7, 263 + 2 * i), Cells(6 + A, 263 + 2 * i)),Type:=xlFillDefault

B = Workbooks(Cells(165 + i, 8) & ".xlsx").Sheets(1).Range("EQ23")
Debug.Print B' 打印EQ23单元格中的数值
Cells(7, 264 + 2 * i).Value2 = "='[" & Cells(165 + i, 8) & ".xlsx]CPTU'!EQ28"
Cells(7, 264 + 2 * i).Select
Selection.AutoFill Destination:=Range(Cells(7, 264 + 2 * i), Cells(6 + B, 264 + 2 * i)), Type:=xlFillDefault
Next 'i
Application.ScreenUpdating = True
End Sub

优化方案建议 #

1. 使用Power Query（推荐） #

无需编写VBA，支持从关闭状态的工作簿批量导入数据，稳定且易维护：

• 操作步骤：
  1. 在汇总文件中，点击「数据」选项卡 →「获取数据」→「从文件」→「从文件夹」
  2. 选择源文件所在的文件夹，加载文件夹列表后，添加自定义列提取目标工作表（CPTU）的EP/EQ列数据
  3. 根据H列的文件名筛选匹配对应数据，最终加载到汇总表，后续可一键刷新数据，无需打开源文件
• 优势：速度快、自动处理路径，支持增量刷新，完全摆脱源文件打开依赖

2. 优化VBA代码（保留VBA场景） #

核心改进方向是减少单元格交互、以只读方式快速读取数据后关闭源文件，避免外部引用依赖：

Sub 批量提取数据优化版()
    Dim wbSource As Workbook
    Dim wsDest As Worksheet
    Dim fileName As String, filePath As String
    Dim lastRowEP As Long, lastRowEQ As Long
    Dim arrEP As Variant, arrEQ As Variant
    
    ' 指定汇总工作表，建议替换为具体表名如Sheets("汇总表")
    Set wsDest = ThisWorkbook.ActiveSheet
    ' 替换为你的源文件实际存放路径
    filePath = "C:\你的源文件文件夹路径\"
    
    ' 禁用屏幕更新和事件触发，提升运行速度
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    For i = 1 To 38
        fileName = wsDest.Cells(165 + i, 8).Value & ".xlsx"
        Debug.Print fileName
        
        ' 以只读模式打开源文件，避免锁定和修改
        Set wbSource = Workbooks.Open(filePath & fileName, ReadOnly:=True)
        
        ' 读取有效行数和整列数据到数组（数组操作远快于单元格逐个读写）
        lastRowEP = wbSource.Sheets(1).Range("EP23").Value
        arrEP = wbSource.Sheets(1).Range("EP28:EP" & 27 + lastRowEP).Value
        lastRowEQ = wbSource.Sheets(1).Range("EQ23").Value
        arrEQ = wbSource.Sheets(1).Range("EQ28:EQ" & 27 + lastRowEQ).Value
        
        ' 将数组数据写入汇总表对应位置
        wsDest.Cells(7, 263 + 2 * i).Resize(lastRowEP, 1).Value = arrEP
        wsDest.Cells(7, 264 + 2 * i).Resize(lastRowEQ, 1).Value = arrEQ
        
        ' 关闭源文件，不保存任何更改
        wbSource.Close SaveChanges:=False
        Set wbSource = Nothing
    Next i
    
    ' 恢复系统设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

• 优化点说明：
  • 用数组一次性读取/写入数据，大幅减少与Excel单元格的交互次数，提升运行速度
  • 以只读模式打开源文件，避免文件锁定和意外修改
  • 禁用事件触发，防止源文件中的宏或事件干扰运行
  • 移除Select/Selection操作，直接操作单元格对象，避免界面卡顿

3. 修复外部引用路径（保留原公式模式） #

如果希望继续使用公式引用，需将公式中的相对路径改为完整绝对路径，这样源文件关闭时也能正常读取数据：

• 修改公式格式为：='C:\源文件完整路径\[文件名.xlsx]CPTU'!EP28
• 可通过VBA批量替换路径：遍历汇总表中包含外部引用的单元格，将'[替换为'C:\源文件路径\[

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