excel - 将最近 5 天工作簿的单元格值汇总到单个工作簿中
问题描述
我有一个要求,每周周五一次,我需要从一周中每天(周一至周五)生成的工作簿中提取一些数据到新工作簿中的每周日期摘要中。新工作簿将是每周的累积视图,当数据粘贴到汇总表时,日期会在周五自动填充。
我需要一些关于如何从逻辑上计算出当前日期的指示,搜索以找到该星期一的第一个文件(但包括星期五的文件),然后将该周的日期范围插入到复制数据旁边的相应单元格中.
我发现其他人的各种帖子都希望做类似的事情,我试图在此基础上开始工作以产生我想要它做的事情。但是,我没有接受过 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
我希望上面的输出每周用五行数据更新我的摘要工作簿,每个数据的日期对应于文件名称中的日期。
解决方案
我需要一些关于如何从逻辑上计算出当前日期的指示,搜索以找到该星期一的第一个文件(但包括星期五的文件),然后将该周的日期范围插入到复制数据旁边的相应单元格中.
以下函数输出日期范围(作为数组),从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
推荐阅读
- android - 列出具有包含在数组中的扩展名的文件
- android - 如何通过扫描 React-Native 上的 QR 码显示选择应用程序的选项
- r - 是否有一个 R 函数可以根据特定的步长获取 2 个数字之间的值?
- pip - Jupyter 没有使用正确的 seaborn 版本
- sql - 新用户无法登录(SQL Server)
- c++ - 运行链表程序时程序崩溃
- r - R:通过匹配另一个数据帧的列来对数据帧中的值进行插值和外推
- javascript - discord.js 无法使用带有用户 ID 的命令
- flutter - 带有参数的 Flutter Web 导航器显示错误,当我刷新路由页面时,它显示 BAD STATE:NO ELEMENT
- wpf - Convert MaterialDesignColors.MaterialDesignColor to SolidColorBrush?