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

将工作簿的最后5天的单元格值汇总成单个工作簿

1 个答案: