OFFSET/INDIRECT的VBA替代方案：无需打开源工作簿如何实现？

一、修复自定义VBA函数的#VALUE!错误 #

你的INDIRECTVBA函数报错，是因为直接引用关闭工作簿的Range对象会失败，且未处理数组返回逻辑。修改后的函数可通过后台临时打开工作簿（不显示界面）读取数据：

Public Function INDIRECTVBA(ref_text As String) As Variant
    Dim wbPath As String, wsName As String, rngAddr As String
    Dim splitParts As Variant, splitRef As Variant
    Dim wb As Workbook, ws As Worksheet, rng As Range
    Dim isClosed As Boolean
    
    ' 解析引用格式：'[工作簿路径]工作表名!单元格区域'
    splitParts = Split(ref_text, "!")
    If UBound(splitParts) < 1 Then
        INDIRECTVBA = CVErr(xlErrRef)
        Exit Function
    End If
    
    rngAddr = splitParts(1)
    splitRef = Split(splitParts(0), "]")
    If UBound(splitRef) < 1 Then
        INDIRECTVBA = CVErr(xlErrRef)
        Exit Function
    End If
    
    wbPath = Left(splitRef(0), Len(splitRef(0)) - 1) ' 移除开头的'['
    wsName = splitRef(1)
    
    ' 检查工作簿是否已打开
    On Error Resume Next
    Set wb = Workbooks(Dir(wbPath))
    On Error GoTo 0
    
    isClosed = (wb Is Nothing)
    If isClosed Then
        ' 后台静默打开工作簿
        Set wb = Workbooks.Open(Filename:=wbPath, ReadOnly:=True, UpdateLinks:=False, Visible:=False)
    End If
    
    ' 读取指定区域数据
    On Error Resume Next
    Set ws = wb.Worksheets(wsName)
    If Not ws Is Nothing Then
        Set rng = ws.Range(rngAddr)
        INDIRECTVBA = rng.Value
    Else
        INDIRECTVBA = CVErr(xlErrName)
    End If
    On Error GoTo 0
    
    ' 关闭后台打开的工作簿
    If isClosed Then
        wb.Close SaveChanges:=False
    End If
    
    Set rng = Nothing
    Set ws = Nothing
    Set wb = Nothing
End Function

修改后原公式可继续使用，函数会自动后台处理工作簿的打开/关闭，无需手动操作。

二、批量提取数据的VBA宏（彻底替代公式） #

如果不想依赖公式，可直接用宏一次性提取所有源工作簿的数据：

Sub BatchExtractData()
    Dim sourceWbPath As String, sourceWb As Workbook
    Dim targetWs As Worksheet, lastRow As Long
    Dim totalRow As Variant, extractRange As Range
    Dim i As Long
    
    Set targetWs = ThisWorkbook.Worksheets("Sheet1") ' 替换为你的目标工作表名
    lastRow = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历A列的工作簿路径
    For i = 1 To lastRow
        sourceWbPath = targetWs.Cells(i, "A").Value
        ' 校验文件是否存在
        If Dir(sourceWbPath) = "" Then
            targetWs.Cells(i, "B").Value = "文件不存在"
            GoTo NextFile
        End If
        
        ' 后台打开源工作簿
        Set sourceWb = Workbooks.Open(Filename:=sourceWbPath, ReadOnly:=True, UpdateLinks:=False, Visible:=False)
        
        ' 查找"Total"所在行（默认取第一个工作表，可自行修改）
        totalRow = Application.Match("Total", sourceWb.Worksheets(1).Range("A:A"), 0)
        If Not IsError(totalRow) Then
            ' 提取2行3列数据
            Set extractRange = sourceWb.Worksheets(1).Cells(totalRow, "A").Resize(2, 3)
            targetWs.Cells(i, "B").Resize(2, 3).Value = extractRange.Value
        Else
            targetWs.Cells(i, "B").Value = "未找到Total"
        End If
        
        ' 关闭源工作簿
        sourceWb.Close SaveChanges:=False
NextFile:
        Set sourceWb = Nothing
    Next i
    
    MsgBox "批量提取完成！"
End Sub

使用说明：

• 将所有源工作簿的完整路径填入A列（如C:\Data\My Workbook.xlsx，同文件夹下可只填文件名）
• 运行宏后，数据会自动写入B列开始的区域

三、Power Query方案（无VBA，更稳定） #

Power Query可直接读取关闭的工作簿数据，步骤如下：

1. 提前将所有源工作簿路径整理成一个名为「源文件列表」的表格（仅一列）
2. 打开目标工作簿，点击「数据」→「获取数据」→「自文件」→「自工作簿」，选择任意一个源工作簿
3. 在导航器中选中对应工作表，点击「转换数据」进入Power Query编辑器
4. 添加自定义列，公式为：=Excel.CurrentWorkbook(){[Name="源文件列表"]}[Content]
5. 展开自定义列，再添加自定义列：=Excel.Workbook(File.Contents([Column1]), null, true)
6. 展开该列，选择目标工作表并展开数据，筛选出包含"Total"的行，提取后续2行3列数据
7. 关闭并上载到当前工作表，后续刷新即可更新数据

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