Excel VBAでローレンツ曲線を描画するマクロを作ってみた２

前回、いくつかのＷＥＢサイトを廻って、ローレンツ曲線用のデータとジニ係数の計算方法を学ぶことができました。

そこで、今回はその計算とグラフ描画をＶＢＡで自動化してみたいと思います。

ソースコード
コードの解説
使い方と実行結果

ソースコード

'ローレンツ曲線を描画し、ジニ係数を計算する
Sub Lorenz_Curve()
    Dim i, j, n
    Dim Arr, Gini

    n = Selection.Rows.Count            'データの行数を格納
    ReDim Arr(1 To 2, 1 To n)           '動的配列のサイズを変更

    Select Case Selection.Columns.Count 'データの列数で分岐
    Case 1  'raw data または 等分の集計データの場合
        Arr(1, 1) = 1
        Arr(2, 1) = Selection(1, 1)
        For i = 2 To n
            Arr(1, i) = Arr(1, i - 1) + 1
            Arr(2, i) = Arr(2, i - 1) + Selection(i, 1)
        Next
    Case 2  '等分でない集計データの場合
        Arr(1, 1) = Selection(1, 2)
        Arr(2, 1) = Selection(1, 1) * Selection(1, 2)
        For i = 2 To n
            Arr(1, i) = Arr(1, i - 1) + Selection(i, 2)
            Arr(2, i) = Arr(2, i - 1) + Selection(i, 1) * Selection(i, 2)
        Next
    Case Else
        MsgBox "一列または二列を選択してください。", vbCritical
        Exit Sub
    End Select

    Application.ScreenUpdating = False
    Worksheets.Add Count:=1

    Cells(3, 1).Value = "累積相対度数"
    Cells(3, 2).Value = "ローレンツ曲線"
    Cells(3, 3).Value = "均等分配線"
    Cells(4, 1).Value = 0
    Cells(4, 2).Value = 0
    Cells(4, 3).Value = 0

    For i = 1 To n
        For j = 1 To 2
            Cells(i + 4, j).Value = Arr(j, i) / Arr(j, n)   '累計÷総計
        Next
        Cells(i + 4, 3).Value = Cells(i + 4, 1).Value       '均等分配線用
        '高さ×（上底＋下底）※２で割らない
        Gini = Gini + (Cells(i + 4, 1) - Cells(i + 3, 1)) _
            * (Cells(i + 4, 2) + Cells(i + 3, 2))
    Next
    Cells(1, 1).Value = "ジニ係数"
    Cells(1, 2).Value = 1 - Gini        'ジニ係数

    Cells.NumberFormatLocal = "0.000"   '小数点の桁数を調整
    Cells.EntireColumn.AutoFit          '列幅を調整

    '散布図作成
    ActiveSheet.Shapes.AddChart2(240, xlXYScatter).Select
    With ActiveChart
        .SetSourceData Source:=Range("'" & ActiveSheet.Name & "'!" & _
            Range(Cells(3, 1), Cells(n + 4, 3)).Address)
        .HasTitle = False                           'グラフタイトル除去
        .SetElement (msoElementLegendBottom)        '凡例を表示
        With .Axes(xlCategory)
            .MaximumScale = 1                       '横軸の最大値
            .TickLabels.NumberFormatLocal = _
                "#,##0.0_);[赤](#,##0.0)"           '横軸の書式
        End With
        With .Axes(xlValue)
            .MaximumScale = 1                       '縦軸の最大値
            .MajorUnit = 0.2                        '縦軸の目盛
            .TickLabels.NumberFormatLocal = _
                "#,##0.0_);[赤](#,##0.0)"           '縦軸の書式
        End With
        With .FullSeriesCollection(1).Format.Line   'ローレンツ曲線
            .Visible = msoTrue
            .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        End With
        With .FullSeriesCollection(2)               '均等分配線
            With .Format.Line
                .Visible = msoTrue
                .Weight = 1
                .DashStyle = msoLineSysDot
                .ForeColor.ObjectThemeColor = msoThemeColorAccent1
            End With
            .MarkerStyle = -4142
        End With
        .Parent.Top = Cells(3, 5).Top       '位置調整（上端）
        .Parent.Left = Cells(3, 5).Left     '位置調整（左端）
        .Parent.Height = 294.8031495        '高さ調整
        .Parent.Width = 283.4645669291      '幅調整
    End With

    Application.ScreenUpdating = True

End Sub

コードの解説

f:id:cyclo-commuter:20180328144324p:plain
ポイントは、raw data と集計データのどちらでも計算できるようにしたところですね。
選択したセル範囲が一列なら横軸（の元）が１ずつインクリメントしますし、二列なら右側の列を横軸（の元）に、２列の積を縦軸（の元）にします。

f:id:cyclo-commuter:20180328135756p:plain
もう一つポイントを挙げるとすると、ジニ係数の計算ですかね。
ジニ係数は、ローレンツ曲線のグラフの青い部分の面積の割合で求められます。

f:id:cyclo-commuter:20180328140408p:plain ÷
で、分母は底辺１×高さ１の三角形の面積ですから、０．５。

さらに、 f:id:cyclo-commuter:20180328140627p:plain の面積は、 f:id:cyclo-commuter:20180328135350p:plain －で、

f:id:cyclo-commuter:20180328135357p:plain の面積は、
f:id:cyclo-commuter:20180328141717p:plain
こんなふうに台形の面積を求め、それを足し合わせて求めます。
台形の面積は、（上底＋下底）×高さ÷２　ですね。
よって、の面積は０．５－ $\sum(台形の面積)$ 、