按月和按年过滤excel电子表格

Question

So I need to find the max price and min price for each month of each year.

Sub Anaylze()
Dim datemonthcount As Long
Dim dateyearcount As Long
Dim yearcount As Long
Dim month As Long
Dim yearstart As Long
Dim maxprice As Long
Dim minprice As Long
Dim rowprice As Long
Dim percentchange

Dim counterlong As Integer

rowprice = 1
yearstart = 2002
counterlong = 0

    Range("A1").Select
    Do Until IsEmpty(ActiveCell) Or ActiveCell.Value = 0 Or IsNumeric(ActiveCell) = False
        counterlong = counterlong + 1 'Increments the counter
         If year(ActiveCell.Text) <> year((ActiveCell.Offset(-1, 0).Text)) Then
         dateyearcount = dateyearcount + 1
         End If
         ActiveCell.Offset(1, 0).Select ' Step down 1 row from present location.
    Loop

    For yearcount = 0 To dateyearcount
    For month = 1 To 12
    'Range("A1", "B" & counterlong).AutoFilter Field:=1, Criteria1:=">=" & month & "/01/" & yearstart, Operator:=xlAnd, Criteria2:="<=" & month & "/31/" & yearstart
    maxprice = WorksheetFunction.Max(Range("A1", "B" & counterlong).AutoFilter(Field:=1, Criteria1:=">=" & month & "/01/" & yearstart, Operator:=xlAnd, Criteria2:="<=" & month & "/31/" & yearstart))
    minprice = WorksheetFunction.Min(Range("A1", "B" & counterlong).AutoFilter(Field:=1, Criteria1:=">=" & month & "/01/" & yearstart, Operator:=xlAnd, Criteria2:="<=" & month & "/31/" & yearstart))
    Cells(rowprice, "g") = maxprice
    Cells(rowprice, "h") = minprice
    rowprice = rowprice + 1 
    Next
    yearstart = yearstart + yearcount
    Next

End Sub

My biggest issue is trying to get the filter to work, my data is formatted in this manner

10/26/2012   61.66
10/25/2012   61.6

Answer 1

Yea, so as Nutsch pointed out - the easiest way to do this is probably with a pivot table:

First you can split up your date into month, day, year:

Then you can adjust your pivot table value field settings:

EDIT/ADDITION

So since you changed your question - here is how I would do what you have been saying in the comments:

=MAX(IF($B$2:$B$22=(B2-1),$E$2:$E$22))

This is an array formula you can enter with control-alt-delete.

And then you can summarize that data however you want.

Answer 2

I Think Stepan1010's answer is in the right direction but if you want VBA code for customization , here is the code for your reference

Sub testing()
    Dim dataArray As Variant ' contains  DATE,VALUE
    Dim intArray As Variant ' contains uniqute identifer MM-YYYY,has operation or not ( BOOLEAN)
    Dim resultArray As Variant ' contains the min/max value, and min / max of the previous month
    Dim min As Double
    Dim max As Double
    With ActiveSheet
        Height = .Cells(.Rows.Count, 1).End(xlUp).Row
        If Height < 2 Then
            MsgBox "Are you sure there's only 1 line or 0 line of data and still want to process?"
            Exit Sub
        End If

        'FIRST SORT THE DATA BY date ascending order
        Application.CutCopyMode = False
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("A1:A" & Height), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:B" & Height)
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        ReDim dataArray(1 To Height, 1 To 2)
        ReDim intArray(1 To Height, 1 To 2)
        ReDim resultArray(1 To Height, 1 To 3)
        dataArray = .Range(.Cells(1, 1), .Cells(Height, 2)).Value
        For i = LBound(intArray, 1) To UBound(intArray, 1)
            intArray(i, 1) = Month(dataArray(i, 1)) & "-" & Year(dataArray(i, 1))
            intArray(i, 2) = False
        Next i


        lastMax = 1
        For i = LBound(dataArray, 1) To UBound(dataArray, 1)
            If Not intArray(i, 2) Then ' not yet found
                    min = dataArray(i, 2)
                    max = dataArray(i, 2)
                For j = i To UBound(dataArray, 1) ' loop later elements
                    If intArray(j, 1) = intArray(i, 1) Then ' if same MM-YYYY
                        If dataArray(j, 2) < min Then
                            min = dataArray(j, 2)
                        End If

                        If dataArray(j, 2) > max Then
                            max = dataArray(j, 2)
                        End If

                        intArray(j, 2) = True 'mark as found(operated)
                    End If
                Next j

                resultArray(i, 1) = min
                resultArray(i, 2) = max


                If i = 1 Then
                    resultArray(i, 3) = 0
                Else
                    resultArray(i, 3) = (min / lastMax) * 100
                End If
                If resultArray(i, 2) > 0 Then
                    lastMax = resultArray(i, 2)
                End If
            End If
        Next i

        ' YOU CAN CHANGE THE VALUE  3 ,5  to the column you prefer
        .Range(.Cells(1, 3), .Cells(Height, 5)).Value = resultArray




    End With
End Sub