制作动态Excel仪表盘时，如何引用关闭工作簿实现INDIRECT公式功能？

核心方案 #

通过VBA动态构建SharePoint文件路径，后台打开源工作簿提取数据后立即关闭，无需用户手动打开源文件。当用户修改仪表盘上的当月日期时，自动触发数据更新。

具体实现代码 #

步骤1：添加工作表变更触发事件

右键仪表盘工作表标签 → 选择「查看代码」，粘贴以下代码（监控A1单元格作为日期输入框，可自行修改单元格位置）：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 仅当修改A1单元格（日期输入框）时触发更新
    If Not Intersect(Target, Me.Range("A1")) Is Nothing Then
        Call UpdateDashboardData
    End If
End Sub

步骤2：添加数据更新核心逻辑

在同一个代码窗口中，粘贴以下主程序和数据提取子程序：

Sub UpdateDashboardData()
    Dim wsDashboard As Worksheet
    Dim targetDate As Date
    Dim yearMonths As Variant ' 存储当月、上月、上上月的年/月
    Dim filePathTemplate As String
    Dim sourcePaths As Variant
    
    ' 初始化仪表盘工作表（替换成你的仪表盘工作表名称）
    Set wsDashboard = ThisWorkbook.Worksheets("仪表盘")
    targetDate = wsDashboard.Range("A1").Value
    
    ' 生成三个月份的年、月字符串（格式：年份yyyy，月份mm）
    yearMonths = Array( _
        Array(Format(targetDate, "yyyy"), Format(targetDate, "mm")), _
        Array(Format(DateAdd("m", -1, targetDate), "yyyy"), Format(DateAdd("m", -1, targetDate), "mm")), _
        Array(Format(DateAdd("m", -2, targetDate), "yyyy"), Format(DateAdd("m", -2, targetDate), "mm")) _
    )
    
    ' 定义SharePoint文件路径模板（替换成你的实际路径，{0}占位年份，{1}占位月份）
    filePathTemplate = "https://oursite.sharepoint.com/sites/sitename/{0}/{1}/Source file.xlsx"
    
    ' 构建三个月份的完整文件路径
    sourcePaths = Array( _
        Replace(Replace(filePathTemplate, "{0}", yearMonths(0)(0)), "{1}", yearMonths(0)(1)), _
        Replace(Replace(filePathTemplate, "{0}", yearMonths(1)(0)), "{1}", yearMonths(1)(1)), _
        Replace(Replace(filePathTemplate, "{0}", yearMonths(2)(0)), "{1}", yearMonths(2)(1)) _
    )
    
    ' 提取数据到对应列：当月→C列，上月→D列，上上月→E列（可自行修改目标列范围）
    Call ExtractData(sourcePaths(0), "Tab name", wsDashboard.Range("B2:B100"), wsDashboard.Range("C2:C100"))
    Call ExtractData(sourcePaths(1), "Tab name", wsDashboard.Range("B2:B100"), wsDashboard.Range("D2:D100"))
    Call ExtractData(sourcePaths(2), "Tab name", wsDashboard.Range("B2:B100"), wsDashboard.Range("E2:E100"))
    
    MsgBox "数据更新完成！"
End Sub

Sub ExtractData(sourceFilePath As String, sourceSheetName As String, lookupRange As Range, resultRange As Range)
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim lookupValue As Variant
    Dim foundCell As Range
    
    ' 关闭屏幕刷新，后台处理
    Application.ScreenUpdating = False
    ' 禁用事件触发，避免循环更新
    Application.EnableEvents = False
    
    ' 后台打开源工作簿（只读模式，不更新链接）
    On Error Resume Next
    Set wbSource = Workbooks.Open(Filename:=sourceFilePath, ReadOnly:=True, UpdateLinks:=False)
    On Error GoTo 0
    
    ' 处理文件无法访问的情况
    If wbSource Is Nothing Then
        resultRange.Value = "文件不可用"
        GoTo Cleanup
    End If
    
    ' 定位源工作表
    Set wsSource = wbSource.Worksheets(sourceSheetName)
    If wsSource Is Nothing Then
        resultRange.Value = "工作表不存在"
        GoTo Cleanup
    End If
    
    ' 遍历查找值，匹配并返回数据（模拟VLOOKUP逻辑）
    Dim i As Integer
    For i = 1 To lookupRange.Rows.Count
        lookupValue = lookupRange.Cells(i, 1).Value
        If Not IsEmpty(lookupValue) Then
            Set foundCell = wsSource.UsedRange.Find(What:=lookupValue, LookIn:=xlValues, LookAt:=xlWhole)
            resultRange.Cells(i, 1).Value = IIf(Not foundCell Is Nothing, foundCell.Offset(0, 1).Value, "无匹配")
        Else
            resultRange.Cells(i, 1).Value = ""
        End If
    Next i

Cleanup:
    ' 关闭源工作簿，不保存
    If Not wbSource Is Nothing Then wbSource.Close SaveChanges:=False
    ' 恢复屏幕刷新和事件触发
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

关键配置说明 #

1. 路径模板修改：将filePathTemplate中的链接替换为你的实际SharePoint路径，确保包含文件后缀（如.xlsx）
2. 工作表与列调整：
   • 修改wsDashboard的工作表名称为你的仪表盘名称
   • 调整lookupRange（仪表盘上的匹配关键字范围）和resultRange（数据输出范围）
   • 如果需要返回匹配单元格的其他列，修改foundCell.Offset(0, 1)中的数字（1代表右侧第一列）
3. 日期输入框：代码默认监控A1单元格，可根据需求修改Worksheet_Change中的目标单元格

使用方式 #

1. 保存仪表盘文件为「启用宏的工作簿（.xlsm）」
2. 用户在指定的日期单元格（默认A1）输入当月日期（如2024/05/01），程序会自动计算上月、上上月的路径并提取数据
3. 如果源文件更新，用户只需重新修改日期（或再次输入相同日期）即可触发重新提取

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