Excel VBAでローレンツ曲線を描画するマクロを作ってみた2
前回、いくつかのWEBサイトを廻って、ローレンツ曲線用のデータとジニ係数の計算方法を学ぶことができました。
そこで、今回はその計算とグラフ描画を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 '均等分配線用
'高さ×(上底+下底)※2で割らない
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
コードの解説
ポイントは、raw data と集計データのどちらでも計算できるようにしたところですね。
選択したセル範囲が一列なら横軸(の元)が1ずつインクリメントしますし、二列なら右側の列を横軸(の元)に、2列の積を縦軸(の元)にします。
もう一つポイントを挙げるとすると、ジニ係数の計算ですかね。
ジニ係数は、ローレンツ曲線のグラフの青い部分の面積の割合で求められます。
÷
で、分母は底辺1×高さ1の三角形の面積ですから、0.5。
さらに、の面積は、-で、
の面積は、
こんなふうに台形の面積を求め、それを足し合わせて求めます。
台形の面積は、(上底+下底)×高さ÷2 ですね。
よって、の面積は0.5-、
ジニ係数は÷ですから、
クドクドと書きましたが、要は2で割って台形の面積を求めても、どうせ後で2をかけることになるんだから、最初から2で割らずに計算するよ、ということです。
使い方と実行結果
使い方は、毎度おなじみ、ソースコード全行をVBEで標準モジュールにコピペしたら、データ範囲を選択して、[開発]→[マクロ]→[Lorenz_Curve]を選択→【実行】をクリックするだけ、です。
一列を選択すると、横軸が等間隔にプロットされます(raw data用)。
二列選択するときは、あらかじめ集計行を右側に配置しておいてください。
実行結果です。
なんだか、7年前よりじわりと格差が広がっているように見えますが、どうでしょうか。