基于年/周可变路径从Excel已关闭工作簿导数据的VBA咨询

1. 现有代码方向校验 #

你当前的VBA编写思路完全正确，没有逻辑偏差：提前关闭屏幕刷新提升运行效率、绑定汇总表对象避免反复激活工作表、用输入框收集核心的年/周参数、预留错误捕获分支，这些都是适配本场景的标准操作。
这个需求的路径规则完全固定，没有随机变动的部分，用VBA实现是性价比最高的方式，不需要额外引入复杂的工具或配置。

2. 非VBA简便替代方案 #

如果不想维护VBA代码，可以直接用INDIRECT动态引用函数实现自动取数，无需任何宏：

• 提前在汇总表的Year列、Week列填好所有待填充的行标记值
• 对应Town 1的列单元格输入公式：=INDIRECT("'A:\Network\"&$A2&"\Week "&$B2&"\[Town 1.xlsx]Sheet1'!$D$4")
• 公式横向拖拽填充到Town2-Town4的列，纵向拖拽到所有行即可
  注意：该方法要求源文件的目录结构严格遵守你描述的规则，不需要手动打开每个源工作簿即可直接读取数值。

3. 现有代码的待补全逻辑 #

你已编写的代码只完成了输入参数收集的部分，后续还需要补充3个核心环节：

• 输入合法性校验：判断用户输入的Year、Week是否为空、是否为合法数值，避免拼接出无效路径
• 目标行定位：自动匹配汇总表中Year、Week值与输入值一致的行，无匹配时在表末自动新增行
• 动态路径拼接与取数：按照固定规则拼接每个城镇的源文件路径，读取$D$4单元格值写入对应列

你提供的示例源路径存在格式偏差：标准跨工作簿引用格式需要在磁盘路径开头补单引号，修正后的完整引用格式为'A:\Network\[2021\Week 1\Town 1.xlsx]Sheet1'!$D$4，拼接时要注意语法不要写错，不然会触发路径无效的报错。

4. 补全后的参考代码 #

Sub AddANewWeek()
    ' ------------- 绑定汇总表对象 -------------
    Application.ScreenUpdating = False
    Dim Town_Summary As Worksheet
    Set Town_Summary = ThisWorkbook.Worksheets("Town Summary")
    
    '------------- 收集用户输入的年、周参数 -------------
    On Error GoTo ErrorMessage
    Dim myYear As Variant
    myYear = InputBox("请输入要提取数据的年份：")
    ' 用户点取消/输入为空则直接退出流程
    If myYear = "" Then Exit Sub
    
    Dim myWeek As Variant
    myWeek = InputBox("请输入要提取数据的周次：")
    If myWeek = "" Then Exit Sub
    
    '------------- 定位目标写入行 -------------
    Dim targetRow As Long
    ' 从第2行开始遍历，匹配年、周值一致的行
    For targetRow = 2 To Town_Summary.Cells(Rows.Count, "A").End(xlUp).Row
        If Town_Summary.Cells(targetRow, "A").Value = myYear And _
           Town_Summary.Cells(targetRow, "B").Value = myWeek Then
            Exit For
        End If
    Next
    ' 没找到匹配行则在表格最后新增一行
    If targetRow > Town_Summary.Cells(Rows.Count, "A").End(xlUp).Row Then
        targetRow = Town_Summary.Cells(Rows.Count, "A").End(xlUp).Row + 1
        Town_Summary.Cells(targetRow, "A").Value = myYear
        Town_Summary.Cells(targetRow, "B").Value = myWeek
    End If
    
    '------------- 循环读取4个城镇的数据 -------------
    Dim basePath As String
    basePath = "A:\Network\" & myYear & "\Week " & myWeek & "\[Town "
    ' 依次遍历第3-6列，对应Town1-Town4的列位置
    Dim townCol As Integer
    For townCol = 3 To 6
        Dim sourcePath As String
        sourcePath = "'" & basePath & townCol - 2 & ".xlsx]Sheet1'!$D$4"
        ' 直接读取关闭状态的源工作簿数据，不需要逐次打开文件
        Town_Summary.Cells(targetRow, townCol).Value = _
            ExecuteExcel4Macro(sourcePath)
    Next
    
    Application.ScreenUpdating = True
    Exit Sub
    
ErrorMessage:
    Application.ScreenUpdating = True
    MsgBox "数据读取失败，请检查对应年份、周次的文件是否存在"
End Sub

代码说明：这里用ExecuteExcel4Macro方法读取关闭状态的源工作簿数据，不需要逐个打开源文件，运行速度远高于逐工作簿打开复制的逻辑。

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