静粛に、只今統計勉強中

仕事でデータ分析をすることになったバリバリ文系アラフィフのおっさんが、独学で統計の勉強を始めました。

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

 

コードの解説

といっても大したことはしていないので、あっさりと。

  1. For ~ Next の二重回しで、3変数以上ある場合の総当りを実現しています。3変数なら、3C2 で集計表とグラフが作られます。

  2. ループの内側前半では、集計表を作ってます。グラフの幅分の列数を空けつつ raw data をコピーして重複行を削除、その右に集計の数式を入力しています。

  3. 後半では、バブルチャートを作って軸を調整してます。工夫としては、ダミー変数*1 かどうかを判別して扱いを変えてるところと、3値以上の場合にレンジの桁数に応じて境界の最小値・最大値をコントロールしてるところですかね。

 

使い方と実行結果

使い方は、毎度おなじみ、ソースコード全行をVBEで標準モジュールにコピペしたら、データ範囲を選択して、[開発]→[マクロ]→[Bubble_Chart]を選択→【実行】をクリックするだけ、です。
f:id:cyclo-commuter:20180216100748p:plain

使用上の注意が3つあります。

  1. 必ず表にラベル行を作っておいてください。
  2. 必ず、表の右側の列は空けておいてください。(値があると上書きされます。)
  3. 必ずラベル行からセル範囲を選択してください。

集計列のラベル名を入力して【OK】をクリックします。(空欄にした場合と【キャンセル】をクリックした場合は、処理が中止されます。)
f:id:cyclo-commuter:20180216101431p:plain

クリック後1~数秒で以下のように結果が出力されます。 
f:id:cyclo-commuter:20180216101800p:plain

散布図行列と同様に総当りで2変数ごとのバブルチャートが作成されます(散布図行列のように美しく並ばないのは大目に見てください。)ので、ロジスティック回帰分析の下準備として、説明変数どうしで相関がありそうかどうかの当たりをつけるのにも使えるかな、と思います。

グラフの見栄えは、エクセルExcelが自動作成した状態よりはマシになっていますが、十分とは言えないかもしれません。
その場合はお手数ですが、グラフの書式設定で適宜調整してください。

*1:ダミー変数については、https://bellcurve.jp/statistics/blog/14094.html の説明がわかりやすいです。