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が指摘したように、これを行う最も簡単な方法は、おそらくピボットテーブルを使用することです。

まず、日付を月、日、年に分割できます。 eg1

次に、ピボットテーブルの値フィールド設定を調整できます。 eg2

eg3

編集/追加

質問を変更したので、コメントであなたが言っていることを私がどのように行うかを次に示します。

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

これは、control-alt-deleteで入力できる配列数式です。

eg4

eg5

eg6

そして、そのデータを好きなように要約できます。

于 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 に答える