问根据日期汇总每行数据

EN

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