将最近 5 天工作簿的单元格值汇总到单个工作簿中

Question

我有一个要求，即每周星期五一次，我需要将每周（周一至周五）每天生成的工作簿中的一些数据提取到新工作簿中的每周日期摘要中。新工作簿将是每周的累积视图，当数据粘贴到汇总表时，日期会在周五自动填充。

我需要一些关于如何从逻辑上计算出当前日期的指针，然后搜索以找到该星期一的第一个文件（但包括星期五的文件），然后将该周的日期范围插入到旁边的相应单元格中复制的数据。

我发现其他人的各种帖子都希望做类似的事情，我已经尝试在此基础上开始工作以产生我想要它做的事情。但是，我没有接受过 VBA 培训，所以我在“尽最大努力”的基础上尝试一切。下面是我编写的代码，它目前只是打开了目录中的最后一个文件。我还有一个单独的选项卡，其中包含我希望在运行宏时考虑到的公共假期。显然，我有很多事情要做，如果我能提供任何关于我应该尝试的提示和指示，我将不胜感激。

Sub WeeklyUpdate()

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim LastPreviousWorkday As Date

'date format to use and where to lookup the bank holidays
LastPreviousWorkday = Application.WorksheetFunction.WorkDay(Date, -1)
LastPreviousWorkday = Format$(LastPreviousWorkday, ("yyyy-mm-dd"))
LastPreviousWorkday = Application.WorksheetFunction.WorkDay(Date, -1, Worksheets("PublicHolidays").Range("A:A"))

'This is where I want it to opens the last 5 days of workbooks from today's date including today e.g. Monday-Friday, report is always run on a Friday
Workbooks.Open "W:\Inventory\Inventory Support\3. Reporting\Daily\Daily Fails Report\Daily Fails Report " & Format(Date, "yyyy-mm-dd") & ".xlsb"

  'Set variables for copy and destination sheets
  Set wsCopy = Workbooks("Daily Fails Report 2019-06-26.xlsb").Worksheets("Daily Fails Report (National)")
  Set wsDest = Workbooks("Weekly Issues Summary.xlsb").Worksheets("CurrentPeriodSummary")

'Find last used row in the copy range based on data in column O
  lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "O").End(xlUp).Row

'Find first blank row in the destination range based on data in column B
'Offset property moves down 1 row to exclude headers
 lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row


'Copy data range excluding the grand total which is always the last row (so use -1 to select the last row above it) & Paste Data into Summary
  wsCopy.Range("O9:Q" & lCopyLastRow - 1).Copy _
    wsDest.Range("B" & lDestLastRow)


End Sub

我希望上面的输出能够用每周五行数据更新我的摘要工作簿，每个数据的日期对应于文件名称中的日期。

Answer 1

我需要一些关于如何从逻辑上计算出当前日期的指针，然后搜索以找到该星期一的第一个文件（但包括星期五的文件），然后将该周的日期范围插入到相应的复制数据旁边的单元格。

以下函数输出日期范围（作为数组），从Today 回到上一个星期一。

Option Explicit
Function dateStuff() As Date()
    Dim lastMonday As Date
    Dim arrDates() As Date
    Dim I As Long

lastMonday = Date - Weekday(Date, vbMonday) + 1

ReDim arrDates(0 To Date - lastMonday)
For I = 0 To UBound(arrDates)
    arrDates(I) = lastMonday + I
Next I

dateStuff = arrDates

End Function

然后您可以使用此函数的输出为相应的工作簿创建名称。

如果我理解您的操作正确，则无需从该列表中排除节假日。由于您不会为假期生成工作簿，因此只需在尝试获取数据时测试该工作簿是否存在。

这是将生成的日期范围放入某个单元格的例程。您可以计算出如何更改rOutput 以反映您的真实目标单元格。这个Sub依赖于上面的Function：

Sub insertDateRange()
    Dim dateRange() As Date
    Dim rOutput As Range

Set rOutput = Worksheets("sheet1").Range("B1")

dateRange = dateStuff

rOutput = dateRange(0) & " - " & dateRange(UBound(dateRange))

End Sub

今天运行27-Jun-2019 宏将输出6/24/2019 - 6/27/2019

但您可以根据需要使用 VBA 格式功能来更改日期的输出格式。

编辑：

就打开工作簿并处理它们而言，只需迭代dateStuff 函数的输出以生成工作簿路径。例如：

'This is where I want it to opens the last 5 days of workbooks from today's date including today e.g. Monday-Friday, report is always run on a Friday
Dim wbDates() As Date, Idx As Long
Dim wbDaily As Workbook, wbPath As String
wbDates = dateStuff 'wbDates now contains an array of the relevant dates

'This will open the workbooks one at a time and you can process them as you wish
'You should refer to this daily workbook as `wbDaily` or some other variable of your choice
For Idx = LBound(wbDates) To UBound(wbDates)
    wbPath = "W:\Inventory\Inventory Support\3. Reporting\Daily\Daily Fails Report\Daily Fails Report " & Format(wbDates(Idx), "yyyy-mm-dd") & ".xlsb"
    If Len(Dir(wbPath)) > 0 Then  'workbook exists
        Set wbDaily = Workbooks.Open(wbPath)
         'your code
         '.....
         wbDaily.Close
    End If
Next Idx