Excel VBAでraw dataからバブルチャートを作るマクロを作ってみた2
前回、エクセルExcelのバブルチャートについて、
- 散布図と違ってraw dataからは作れないので、集計の手間がかかる。
- 自動的に作成されたままだと、ゴチャゴチャして分布が見えづらいことがある(書式の調整が必要)。
というお話をしました。
そこで、そのちょっとした手間を省くためのマクロを作成してみました。
ソースコード
'raw data からバブルチャートを作成する
Sub Bubble_Chart()
Dim i, j, n, v
Dim Tmp As String, RC1 As String, RC2 As String
Dim Rng As Range
Tmp = InputBox("集計列のラベル名称を入力してください。", "バブルチャート", "集計")
If Tmp = "" Then Exit Sub
Application.ScreenUpdating = False
With Selection
n = .Rows.Count
v = .Columns.Count
For i = 1 To .Columns.Count - 1
For j = i To .Columns.Count - 1
RC1 = .Offset(, i - 1).Resize(, 1).Address(ReferenceStyle:=xlR1C1)
RC2 = .Offset(, j).Resize(, 1).Address(ReferenceStyle:=xlR1C1)
.Offset(, i - 1).Resize(, 1).Copy Destination:=.Offset(, v + 1).Resize(, 1)
.Offset(, j).Resize(, 1).Copy Destination:=.Offset(, v + 2).Resize(, 1)
With .Offset(, v + 1).Resize(n, 2)
.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
.Sort Key1:=.Resize(1, 1), Order1:=xlAscending, _
Key2:=.Offset(, 1).Resize(1, 1), Order2:=xlAscending, Header:=xlYes
.Resize(, 1).Copy Destination:=.Offset(, 2).Resize(, 1)
Set Rng = Range(.Resize(1, 1), .Resize(1, 1).End(xlDown))
With .Offset(, 2).Resize(Rng.Rows.Count, 1)
.FormulaR1C1 = "=COUNTIFS(" & RC1 & ",RC[-2]," & RC2 & ",RC[-1])"
.Resize(1).Value = Tmp
End With
End With
Rng.Resize(, 3).Borders(xlEdgeBottom).LineStyle = True
ActiveSheet.Shapes.AddChart2(269, xlBubble).Select
With ActiveChart
Set Rng = Rng.Offset(1).Resize(Rng.Rows.Count - 1, 3)
.SetSourceData Source:=Rng
With .Axes(xlCategory)
If IsDummy(Rng.Resize(, 1)) = True Then
.MajorUnit = 1
.CrossesAt = -1
Else
.MinimumScale = FitScale(Rng.Resize(, 1))(0)
.MaximumScale = FitScale(Rng.Resize(, 1))(1)
.CrossesAt = .MinimumScale
End If
End With
With .Axes(xlValue)
If IsDummy(Rng.Offset(, 1).Resize(, 1)) = True Then
.MajorUnit = 1
.CrossesAt = -1
Else
.MinimumScale = FitScale(Rng.Offset(, 1).Resize(, 1))(0) - 1
.MaximumScale = FitScale(Rng.Offset(, 1).Resize(, 1))(1) + 1
.CrossesAt = .MinimumScale
End If
End With
.Parent.Top = Rng.Offset(-1, 3).Top + 7 '位置調整(上端)
.Parent.Left = Rng.Offset(-1, 3).Left + 7 '位置調整(左端)
End With
v = v + 10
Next
Next
End With
Application.ScreenUpdating = True
End Sub
Function IsDummy(Arg) As Boolean
Dim r As Range
IsDummy = True
For Each r In Arg
Select Case r
Case 0, 1
Case Else
IsDummy = False
Exit For
End Select
Next
End Function
Function FitScale(Arg)
Dim Tmp, rv, w
With Application.WorksheetFunction
Tmp = .RoundUp((.Max(Arg) - .Min(Arg)) / 10, 0)
rv = Len(Tmp) - 1
w = .Floor_Math(Tmp, 10 ^ rv)
FitScale = Array(.Min(Arg) - w, .Max(Arg) + w)
End With
End Function
コードの解説
といっても大したことはしていないので、あっさりと。
- For ~ Next の二重回しで、3変数以上ある場合の総当りを実現しています。3変数なら、3C2 で集計表とグラフが作られます。
- ループの内側前半では、集計表を作ってます。グラフの幅分の列数を空けつつ raw data をコピーして重複行を削除、その右に集計の数式を入力しています。
- 後半では、バブルチャートを作って軸を調整してます。工夫としては、ダミー変数*1 かどうかを判別して扱いを変えてるところと、3値以上の場合にレンジの桁数に応じて境界の最小値・最大値をコントロールしてるところですかね。
使い方と実行結果
使い方は、毎度おなじみ、ソースコード全行をVBEで標準モジュールにコピペしたら、データ範囲を選択して、[開発]→[マクロ]→[Bubble_Chart]を選択→【実行】をクリックするだけ、です。
使用上の注意が3つあります。
- 必ず表にラベル行を作っておいてください。
- 必ず、表の右側の列は空けておいてください。(値があると上書きされます。)
- 必ずラベル行からセル範囲を選択してください。
集計列のラベル名を入力して【OK】をクリックします。(空欄にした場合と【キャンセル】をクリックした場合は、処理が中止されます。)
クリック後1~数秒で以下のように結果が出力されます。
散布図行列と同様に総当りで2変数ごとのバブルチャートが作成されます(散布図行列のように美しく並ばないのは大目に見てください。)ので、ロジスティック回帰分析の下準備として、説明変数どうしで相関がありそうかどうかの当たりをつけるのにも使えるかな、と思います。
グラフの見栄えは、エクセルExcelが自動作成した状態よりはマシになっていますが、十分とは言えないかもしれません。
その場合はお手数ですが、グラフの書式設定で適宜調整してください。
*1:ダミー変数については、https://bellcurve.jp/statistics/blog/14094.html の説明がわかりやすいです。