Question

我从第2-7行得到了一些数据。

我想将前几个月 的所有数据合并为一行，所以从下图中我想结合05/05 / 05的数据2014-07 / 09/2014，但保留最近最近一个月 的数据，但未合并。所以我需要总结G列和H列中的数据，对于行2-4，其他列无关紧要。

第11-14行是我想要实现的目标。我该怎么做（宏观或其他）？

Answer 1

看看这是否能让你入门：

Sub Summary()
    Dim FirstDataRow As Long
    Dim LastDataRow As Long
    Dim DataRow As Long
    Dim cDates As Long
    Dim cAmounts As Long
    Dim CutoffDate As Date
    Dim EarliestOldDate As Date
    Dim LatestOldDate As Date
    Dim SumOfOld As Long
    Dim OldMonthsRow As Long
    Dim OffSetToSummaryTable As Long
    Dim InputRow As Long
    Dim OutputRow As Long
    Dim TheDate As Date
    Dim TheAmount As Long
    Dim ws As Worksheet

    ' INITIALIZE
    ' Assume we're operating on the activesheet
    Set ws = ActiveSheet

    ' Assume data starts in Row 2
    FirstDataRow = 2

    ' Assume data is a contiguous block
    LastDataRow = ws.Range("F" & CStr(FirstDataRow)).End(xlDown).Row

    ' Assume 3 empty rows between input and summary table
    OffSetToSummaryTable = 3

    ' Calculate row where sum of old months goes
    OldMonthsRow = LastDataRow + OffSetToSummaryTable + 1

    ' Calculate the cutoff date = first date of current month
    CutoffDate = DateSerial(2015, 1, 1)
    ' CutoffDate = DateSerial(Year(Date), Month(Date), 1)

    ' Column where dates are
    cDates = 6

    ' Column where amounts are
    cAmounts = 7

    ' Initialize earliest and latest old dates, and sum of old
    EarliestOldDate = DateSerial(3000, 12, 31)  ' Way out in the future
    LatestOldDate = DateSerial(1904, 1, 1)      ' Way back in the past
    SumOfOld = 0


    ' PROCESS THE DATA
    OutputRow = OldMonthsRow
    For InputRow = FirstDataRow To LastDataRow
        TheDate = ws.Cells(InputRow, cDates)
        TheAmount = ws.Cells(InputRow, cAmounts)

        If TheDate >= CutoffDate Then
            ' Add at the bottom of the summary table
            OutputRow = OutputRow + 1
            ws.Cells(OutputRow, cDates).Formula = TheDate
            ws.Cells(OutputRow, cAmounts).Formula = TheAmount
        Else
            ' Update results for previous months
            EarliestOldDate = IIf(TheDate < EarliestOldDate, TheDate, EarliestOldDate)
            LatestOldDate = IIf(TheDate > LatestOldDate, TheDate, LatestOldDate)
            SumOfOld = SumOfOld + TheAmount
        End If

    Next InputRow

    ' WRITE RESULTS TO SUMMARY ROW
    ws.Cells(OldMonthsRow, cDates).Formula = Format(EarliestOldDate, "dd/mm/yyyy") & " - " & Format(LatestOldDate, "dd/mm/yyyy")
    ws.Cells(OldMonthsRow, cAmounts).Formula = SumOfOld

    Set ws = Nothing
End Sub

根据日期汇总每行数据

1 个答案: