searchExcel表格以查看使用VBA按月整理数据的date
我在工作簿中有一个未知数量的表格，但每个表格都有相同的格式。 每张表代表一个工作周。 这些星期可能跨越几个月。 每一列都有一行反映了一周中的某一天，并有一个date单元格。 date格式为dd / mm / yr
我的代码当前find了工作表的数量，并通过工作表进行分析，以将特定信息合并到汇总表中。 此信息采用年迄今（YTD）格式。
除了YTD格式之外，我还需要能够以日历月的forms提取数据。
每张纸最多有5个数据单元（每周一个）和两个最多5个单元格（即path小时数和总小时数，最多5个条目 – 周一至周五，如果在活动月份中）细胞将被汇总在一起，产生两个总和。 这需要在一个日历月的每个工作周内完成，然后将总值输出到我的汇总表。
下面的代码是我用来通过每个数据表并抓取YTD数据。 我想添加代码来涵盖每月的数据提取，但是我很难实现这样的代码 – 我一直在心理学界。
Dim I As Integar Dim WS_Count As Integar Dim ConsolidationArrayYTDTotalDailyAve() 'Array storage YTD Tot Daily Ave WS_Count = ActiveWorkbook.Worksheets.Count ' last worksheet ReDim ConsolidationArrayYTDTotalDailyAve(WS_Count-2) For I = 2 to WS_Count 'check from 2nd WS as first sheet is the summary ConsolidationArrayYTDTotalDailyAve(I - 2) = Worksheets(I).Name & "!R54C3:R56C8" 'Grab the data from each sheet and save in the array Next I Sheets("Summary").Range("B4").Consolidate sources:=(ConsolidationArrayYTDTotalDailyAve), Function:=xlAverage 我在想以下的devise（do while循环在上面的For循环中 – 而不是实际的代码只是试图expression思考过程）：
Dim Im As Integer 'Same function as I when parsing through sheets Dim FirstDay As Date 'first day of the month Dim LastDay As Date 'last day of the month Dim Month as Integer 'tracks active month 1 through 12 Dim RouteHrsSum As Single 'stores the sum of monthly Route Hours Dim TotalHrsSum As Single 'stores the sum of monthly Total Hours Month = 1 'set default month to January Do While (ActiveCell >= FirstDay & ActiveCell <= LastDay) & Month <= 12 For Im = 2 to WS_Count IF Month = 1 Then FirstDay = 1/1/2016 & LastDay = 31/1/2016 ElseIF Month = 2 Then FirstDay = 1/2/2016 & LastDay = 29/02/2016 ETC... Else FirstDay = 1/12/2016 & LastDay = 31/12/2016 Action: Scan a range of cells for dates for the active month IF Date of Active Month found then sum cells A2, B2, C2 together, sum cells A9,B9,C9 together and write both sums to a pair of storage vairables (RouteHrsSum and TotalHrsSum respectively) Else Output RouterHrsSum & TotalHRsSum to respective cells on sheeet 1 Month = Month + 1 'Make next month active 'need to be able to recheck the last worksheet for a calendar month straddle and get data if so for new month's days Next Im Loop
数据工作表样本:(截至8月19日的一周）
Driver Bob Monday Tuesday Wednesday Thursday Friday 15-Aug 16-Aug 17-Aug 18-Aug 19-Aug Kilometres 318 91 119 219 394 Route Hours 5.74 4 2.5 4.25 6 Total Hours 9 9 9 9 10
数据工作表的示例:(周末结束日历月）
Driver Bob Monday Tuesday Wednesday Thursday Friday 29-Aug 30-Aug 31-Aug 1-Sept 2-Sept Kilometres 300 110 119 89 394 Route Hours 7 4 2.5 4.25 6 Total Hours 9 9 9 9 9
从概念上讲，我觉得自己在正确的轨道上，但是当涉及到实际的代码和devise时，我总是陷入困境。 任何援助表示赞赏。 我很抱歉，如果这是模糊的，但我不能看到树木的森林。
我将随时编辑这个问题的内容作为更清晰的呈现。
我认为编译数据和使用整合一样简单。
Sub ProcessData() Dim arTemp Dim d As Date Dim x As Long, y As Integer Dim ws As Worksheet Dim list As Object Set list = CreateObject("System.Collections.SortedList") For Each ws In Worksheets If ws.Name <> "Summary" Then With ws For y = 2 To 6 d = DateSerial(Year(.Cells(2, y)), Month(.Cells(2, y)), 1) If list.ContainsKey(d) Then arTemp = list(d) Else ReDim arTemp(2) End If arTemp(0) = arTemp(0) + .Cells(3, y) arTemp(1) = arTemp(1) + .Cells(4, y) arTemp(2) = arTemp(2) + 1 list(d) = arTemp Next End With End If Next With Worksheets("Summary") .Cells.Delete .Range("A1:F1") = Array("Year", "Month", "Avg. Kilometres", "Avg. Route Hours", "Sum Kilometres", "Sum Route Hours") For x = 0 To list.Count - 1 d = list.GetKey(x) .Cells(x + 2, 1) = Year(d) .Cells(x + 2, 2) = Month(d) .Cells(x + 2, 3) = list(d)(0) / list(d)(2) .Cells(x + 2, 4) = list(d)(1) / list(d)(2) .Cells(x + 2, 5) = list(d)(0) .Cells(x + 2, 6) = list(d)(1) Next .Rows(x + 2).Columns("C:D").FormulaR1C1 = "=Average(R[-" & x & "]C:R[-1]C)" .Rows(x + 2).Columns("E:F").FormulaR1C1 = "=Sum(R[-" & x & "]C:R[-1]C)" .Columns("C:F").NumberFormat = "0.00" .Columns.AutoFit End With End Sub