Question

所以我需要找到每年每个月的最高价格和最低价格。

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

我最大的问题是尝试让过滤器工作，我的数据以这种方式格式化

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

Answer 1

是的，正如Nutsch指出的那样 - 最简单的方法就是使用数据透视表：

首先，您可以将日期分为月，日，年： eg1

然后您可以调整数据透视表值字段设置： eg2

eg3

<强> EDIT / ADDITION

所以，既然你改变了自己的问题 - 以下是我将如何做你在评论中所说的话：

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

这是一个可以使用control-alt-delete输入的数组公式。

eg4

eg5

eg6

然后，您可以根据需要总结该数据。

Answer 2

我认为Stepan1010的答案是正确的但如果您想要VBA代码进行自定义，请参考以下代码

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

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

2 个答案: