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

Posted 2023-04-13

【中文标题】根据变量定义的路径从多个关闭的工作簿中导入数据

【英文标题】：Importing data from multiple closed workbooks based on variable defined path

【发布时间】：2021-02-18 17:59:33

【问题描述】：

我在试图找到解决问题的方法时遇到了困难。以下是我正在尝试做的总结：

情况：我每周收到 4 个相同的工作表，我需要在我的摘要工作表上合并数据：

Year	Week	Town 1	Town 2	Town 3	Town 4
2021	Week 1
2021	Week 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 周的数据：

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

Inputs 将创建文件路径：A:\Network\ Year Input \ Week Input \ [Header.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:")

【问题讨论】：

@Gass 我非常感谢您认为需要的尽可能多的会议，谢谢您的提议，我正在给您发送电子邮件

这是一个好的开始@CMC。年份总是当前年份吗？如果是这种情况，我们可以使用Format$(Date, "yyyy") 获取当前年份而无需输入。

在您的解决方案想法中，您在路径 HEADER 而不是 TOWN 中为 .xlsx 文件使用了不同的名称，您能再解释一下吗？ ...工作表的名称是始终相同还是会更改？

@Gass 谢谢 - 如果这样更容易，年份总是可以是当前年份，唯一可能的问题可能是 12 月的最后一周。如果用户在 12/31 收到数据，但要到明年 1/2 才导入。

我们可以做一个只在 12 月和 1 月工作的输入系统。在今年剩下的时间里，它将是自动的。

【参考方案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

【讨论】：

非常感谢 - 我遇到的一个错误是几周内我可能无法收到来自 Town 2 的数据。我将错误处理编辑为On Error Resume Next，但代码将最后一个成功导入的值拉入到找不到文件的单元格中，有没有办法留空并继续下一列？

我很高兴为您工作@CMC。我更新了代码。你现在不应该有错误。如果您对我所做的事情感兴趣，我添加了一个函数，该函数根据文件是否存在返回 true 或 false。如果没有，它会跳过它并继续下一个。

【参考方案2】：

这可以在没有 VBA 的情况下使用 Power Query（获取和转换）轻松完成。整个解决方案对于一个答案来说有点多，但这里有一些起点。

用户可以将参数输入到工作表单元格中。公式可以获取该条目并生成文件路径。

Power Query 可以读取文件路径并加载该文件夹中的所有文件以进行进一步处理。

网上有很多关于 Excel 中的 Power Query 的免费资源。这个是关于参数的

https://exceloffthegrid.com/power-query-using-parameters/

还有一篇关于导入文件夹中的所有文件

https://exceloffthegrid.com/power-query-import-all-files-in-a-folder/