Excel VBAでコレログラムを作成するマクロを作ってみた３

前回までの２回で、Excelで自己相関係数を計算し、コレログラムを作成するところまでできましたので、今回は、この一連の手順をVBAマクロで自動化したいと思います。

といっても、計算はたいしてややこしいものではありませんし、グラフ作成の自動化も前に何度もやってますから、これといって新機軸はありません。

ので、ソースコードを、さらっと。

'時系列データからコレログラムを作成する
Sub CORRELOGRAM()

    Dim Lag
    Dim n As Integer
    Dim Avg As Double
    Dim i As Integer, j As Integer
    Dim Mat1, Mat2
    Dim CLM As Integer
    Dim Acov
    
    Lag = InputBox("自己相関係数を計算するラグ（時間差）の数を整数で入力してください。" & vbCrLf & _
        vbCrLf & "ただし、下限を［２］、上限を［選択範囲の行数－１］とします。", "コレログラム")

    n = Selection.Rows.Count    'データ数をnに格納

    Select Case Lag
    Case 2 To n - 1
        Avg = WorksheetFunction.Average(Selection)  '平均値をAvgに格納
        
        ReDim Mat1(1 To n)  '動的配列変数Mat1を初期化
        ReDim Acov(Lag)     '動的配列変数Acovを初期化
        
        For j = 1 To n
            Mat1(j) = Selection(j).Value - Avg  'Mat1にラグ0の偏差を格納
        Next
        Acov(0) = WorksheetFunction.SumSq(Mat1) / n 'Acov(0)にラグ0の分散を格納
        
        'ワークシートに自己相関係数を記述する（見出しとラグ0）
        CLM = Selection.Column + 2
        Cells(1, CLM).Value = "ラグ（時間差）"
        Cells(1, CLM + 1).Value = "自己相関係数"
        Cells(2, CLM).Value = "'0"
        Cells(2, CLM + 1).Value = 1
        
        For i = 1 To Lag
            ReDim Mat2(1 To n)  '動的配列変数Mat2を初期化
            For j = 1 To n - i
                Mat2(j) = Selection(i + j).Value - Avg  'Mat2にラグiの偏差を格納
            Next
            Acov(i) = WorksheetFunction.SumProduct(Mat1, Mat2) / n  'Acov(i)にラグ0とラグiの自己共分散を格納
            'ワークシートに自己相関係数を記述する（ラグi）
            Cells(i + 2, CLM).Value = "'" & i
            Cells(i + 2, CLM + 1).Value = Acov(i) / Acov(0)
        Next
        
        '自己相関係数の表に基づき、棒グラフを作成する
        ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
        With ActiveChart
            .SetSourceData Source:=Range(Cells(2, CLM), Cells(Lag + 2, CLM + 1))
            .ChartTitle.Delete
            .Axes(xlCategory).TickLabelPosition = xlLow
            .Axes(xlValue).MinimumScale = -1
            .Axes(xlValue).MaximumScale = 1
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Text = "自己相関係数"
            .Axes(xlCategory, xlPrimary).AxisTitle.Text = "時間差"
        End With
    Case vbNullString
    Case Else
        MsgBox "自己相関係数を計算するラグの数を整数で入力してください。" & vbCrLf & _
            vbCrLf & "ただし、下限を［２］、上限を［選択範囲の行数－１］とします。", vbCritical, "コレログラム"
    End Select

End Sub