excel - 根据变量定义的路径从多个关闭的工作簿中导入数据

Question

我在试图找到解决问题的方法时碰壁了。这是我正在尝试做的事情的摘要:
情况:我每周收到 4 个相同的工作表，我需要在我的摘要工作表上合并数据:


年
星期
1号镇
2号镇
3号镇
4号镇


2021
第 1 周



2021
第 2 周




工作表:我每周都会收到相同的工作表，其中包含我需要拉出的单元格的路径，如下所示:
A:\Network\2021\Week 1[Town 1.xlsx]Sheet1'!$D$4'
A:\Network\2021\Week 1[Town 2.xlsx]Sheet1'!$D$4'
A:\Network\2021\Week 1[Town 3.xlsx]Sheet1'!$D$4'
A:\Network\2021\Week 1[Town 4.xlsx]Sheet1'!$D$4'
想法/解决方案:
用户想要填充第 1 周的数据:

使用 InputBox 提示用户输入年和周，这将成为文件路径中的变量以提取数据

输入将创建文件路径:A:\Network\年份输入 \周输入 \[ 标题 .xlsx]Sheet1'!$D$4'

然后使用该输入从每个工作簿中提取数据

我现在在哪里:
从我的研究来看，我似乎必须使用 vba 来实现这一点，但我不是专家，你会碰巧知道一个更简单的方法，或者让我知道我的代码是否在正确的轨道上？

Sub AddANewWeek ()
    ' ------------- Town Summary Worksheet -------------
    
    Application.ScreenUpdating = False
    
    Worksheets("Town Summary").Activate
    
    Dim Town_Summary As Worksheet
    Set Town_Summary = Worksheets("Town Summary")
    
    '------------- User inputs the name of the Year-Week to extract the data -------------
    
    On Error GoTo ErrorMessage
    
    Dim myYear As Variant
    myYear = InputBox("Please enter the Year to extract data:")

    On Error GoTo ErrorMessage
    
    Dim myWeek As Variant
    myWeek = InputBox("Please enter the Week to extract data:")

Answer 1

在尝试之前在代码的 CONFIG 区域进行必要的更改。

Sub add_new_week()

Dim path As String, root_path As String
Dim town_data As String, slash As String
Dim year As Long, next_col As Long, N As Long, week_number As Long
Dim town1_col As Integer, town1_row As Integer, next_row As Integer
Dim input_range As Range
Dim source_wb As Workbook, main_wb As Workbook

Set main_wb = ActiveWorkbook

'CONFIG
'---------------------------------
root_path = "A:\Network\"
town_data = "D4" 'set the range for the source data
town1_col = 4    'set the COLUMN number for Town 1 in Town Summary sheet
town1_row = 5    'set the ROW number for Town 1 in Town Summary sheet
'---------------------------------

Set input_range = _
Application.InputBox("Where would you like to start pasting the data?", Type:=8)

week_number = InputBox("Please enter the WEEK NUMBER to extract data")

next_row = input_range.Row
next_col = input_range.Column

'Windows and Mac compatibility
slash = Application.PathSeparator

'if is december or january input the year
If format$(Date, "mmmm") = "December" Or format$(Date, "mmmm") = "January" Then
    year = InputBox("Please enter the YEAR to extract data")
    Else: year = format$(Date, "yyyy")
End If

For N = 1 To 4
   
    On Error GoTo ErrMsg
    path = _
    root_path & year & slash & "Week " & week_number & slash & _
    main_wb.Sheets("Town Summary").Cells(town1_row, town1_col) & ".xlsx"
    
    If file_exists(path) = True Then
    
        Set source_wb = Application.Workbooks.Open(path)
        
        source_wb.Sheets("Sheet1").Range(town_data).Copy
        main_wb.Sheets("Town Summary").Cells(next_row, next_col).PasteSpecial
        
        source_wb.Close

    End If

    next_col = next_col + 1
    town1_col = town1_col + 1

Next

format_table

main_wb.Sheets("Town Summary").Range("A1").Select

Exit Sub

ErrMsg:
MsgBox ("Please enter a valid number."), , "Week number not found"

End Sub

Function file_exists(path As String) As Boolean

Dim test As String

    test = ""

    On Error Resume Next
    test = Dir(path)
    On Error GoTo 0
    If test = "" Then
        file_exists = False
    Else
        file_exists = True
    End If
    
End Function

Sub format_table()

    Cells.Select
    With Selection
        .HorizontalAlignment = xlLeft
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.InsertIndent 1
    With Selection.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Selection.RowHeight = 22
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 1
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub