0

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

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

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

2012 年 10 月 26 日 61.66
2012 年 10 月 25 日 61.6
4

2 回答 2

2

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

首先，您可以将日期拆分为月、日、年： 例如1

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

例如3

编辑/添加

因此，既然你改变了你的问题 - 这就是我将如何做你在评论中所说的：

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

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

例4

例5

例6

然后你可以随心所欲地总结这些数据。

于 2012-10-29T21:57:54.893 回答
0

我认为 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
于 2012-10-30T10:56:38.077 回答