散布図行列の作成 with Excel VBA

イントロダクション

Excelで散布図行列を描くことを目的とした，マクロの作例です。仕様としては，左下半分に散布図・右上半分に相関係数を表示する形式を採用しています。この相関係数は，値|0.3|程度を目安にして，フォントサイズを固定式より比例式に切り替えます(この仕様を塞ぐことも可)。

「R」ではpairs()関数などにより簡単に作成できる散布図行列も，Excelでは筆者の知る限りなかなかの困難を伴うようです。アドインの「分析ツール」―「相関」機能には散布図行列を作成するオプションが現状では用意されていないので，これをマクロでなんとかするのがこのページの趣旨ですが，ひょっとするとこれはバッドノウハウの範疇にかかる内容のような気がしないでもありません。

とまれ以下，Excelで散布図行列を描くにあたって必要とされる多大な手間の軽減を目的としたマクロの導入と実行に関する手続きです。

Step 0シチュエーションの設定

企業情報サービス会社Xがあります。Xは同社の提供するオンライン情報サービスについて，ある期間におけるデータの参照数を会員ID別・記事項目別にまとめました(下表)。

この表は，左端1列が項目列，その他の列が変数列(ここでは9個)となっています。このマクロは，指定したひと続きの変数列の組み合わせにおいて散布図を作成します。したがって選択範囲に空白列を挟む場合には正常に機能しません。

免責および特記事項

このマクロはあくまでデモンストレーションを目的としたものです。すべての環境で正常に動作することを保証するものではありません。
その上でマクロをご利用いただく場合，従前の方法と比較して内容を照合し，整合性が保たれているかを安全な環境で十分に確認してください。精度不足あるいは予期しないデータ消失等のトラブルにつきまして，筆者は一切責任を負いかねます。
10程度の変数・30程度のサイズの元データを想定しています。筆者はその水準までしか動作を確認していません。
マクロの動作自体の検証(正常に動作するか，あるいは処理にどの程度の時間がかかるかといったことの確認)には，このテストデータが利用できます。任意のシートのセルA1にコピペしてお使いください。

工程

コードの導入

Step 1VBE(Visual Basic Editor)の起動

開発タブ「コード」グループのVisual Basicボタンをクリックします。

Step 2VBEの操作・VBAコードの導入(1)

VBEの挿入メニュー標準モジュールをクリックします。

Step 3VBEの操作・VBAコードの導入(2)　コードのコピー

次のコードをすべて選択し，コピーします。

Const Ratio As Double = 0.1 ' レンジに加えるマージンの量(初期値:10%)

Sub SCATTERMATRIX1_draw()

' *** 散布図行列の作成 ver.2.0.0
' *** bdastyle.net/tools/correlation-coefficient/page5-scattermatrix.html
' *** by hawcas 2014, 2016

On Error GoTo myError

Application.ScreenUpdating = False

Const axLeft As Long = 100 ' 描画開始位置(pt, 左)
Const axTop As Long = 100 ' 描画開始位置(pt, 上)
Const paWidth As Long = 100 ' セルサイズ(pt, 幅)
Const paHeight As Long = 100 ' セルサイズ(pt, 高さ)
Const adjY As Long = 64 ' Y方向のラベルの突き出し(-:増える +:減る)
Const adjX As Long = 36 ' X方向のラベルの突き出し(+:増える -:減る)

Dim v As Long ' 変数の数
Dim n As Long ' サイズ
Dim header() As String ' 見出し格納用の配列
Dim r() ' 相関係数格納用の配列
Dim param1 As String ' 変数1のデータ範囲
Dim param2 As String ' 変数2のデータ範囲

Dim xMin As Double ' x軸のMin
Dim xMax As Double ' x軸のMax
Dim yMin As Double ' y軸のMin
Dim yMax As Double ' y軸のMax
Dim xMgn As Double ' x軸のマージン
Dim yMgn As Double ' y軸のマージン

Dim head As Shape ' 「見出し」オブジェクト
Dim cor As Shape ' 「相関係数」オブジェクト

Dim x As Long   ' 以下カウンタ
Dim y As Long

' 変数の数の取得
v = ActiveWindow.RangeSelection.Columns.Count
' データサイズの取得
n = ActiveWindow.RangeSelection.Rows.Count - 1

If v < 2 Or n < 4 Then ' [エラー処理1] 選択範囲が適切か簡易チェック
    MsgBox "選択範囲が正しくない可能性があります"
    Exit Sub
End If

' 変数名・相関係数用配列の再定義
ReDim header(v)
ReDim r(v, v)

' 変数名を配列に格納
For x = 1 To v
    header(x) = ActiveSheet.Range(ActiveWindow.RangeSelection.Address).Cells(1, x).Value
    If IsNumeric(header(x)) = True Or header(x) = "" Then ' [エラー処理2] 見出しが数値型 or "" を弾く
        MsgBox "数値型、もしくは空の変数名は利用できません"
        Exit Sub
    End If
Next
    Dim vlu ' ［エラー処理3］データが数値型かを確認
    For Each vlu In ActiveWindow.RangeSelection.Range("a2").Resize(RowSize:=n, ColumnSize:=v)
        If IsNumeric(vlu) = False Then
            MsgBox "見出しを除く範囲に、文字型のデータを利用することはできません"
            Exit Sub
        End If
    Next

' ブックを複写
ActiveSheet.Copy

' マトリクスを描画
For x = 1 To v ' ［ループA］列方向の処理
        param1 = ActiveWindow.RangeSelection.Cells(2, x).Address & ":" & _
            ActiveWindow.RangeSelection.Cells(2 + n - 1, x).Address ' 変数1のアドレス(文字列)を作成し
        xMin = Application.WorksheetFunction.Min(Range(param1)) ' 項目軸のMinと
        xMax = Application.WorksheetFunction.Max(Range(param1)) ' Maxを求める
        
    For y = 1 To v ' ［ループB］行方向の処理
        param2 = ActiveWindow.RangeSelection.Cells(2, y).Address & ":" & _
            ActiveWindow.RangeSelection.Cells(2 + n - 1, y).Address ' 変数2のアドレス(文字列)を作成する

        ' 描画するオブジェクトをx,yの内容によって分岐させる
        Select Case x
            Case Is < y ' 散布図行列(マトリクスの左下部を描く)
                    r(x, y) = Application.WorksheetFunction.Pearson(Range(param1), Range(param2)) ' 相関係数を計算し
                    yMin = Application.WorksheetFunction.Min(Range(param2)) ' 数値軸のMinと
                    yMax = Application.WorksheetFunction.Max(Range(param2)) ' Maxも求めておく
                    
                    If x = 1 Then ' y方向のラベル(グラフオブジェクト)を作る
                        ActiveSheet.Shapes.AddChart(xlXYScatter, axLeft + adjY, axTop + y * paHeight, _
                            paWidth, paHeight).Select ' 引数：Left top width height
                        ActiveChart.SetSourceData Source:=Range(param1 & "," & param2) ' データ範囲の指定
                            yMgn = Margin(yMin, yMax) ' y軸マージン量の決定
                            xMgn = Margin(xMin, xMax) ' x軸マージン量の決定
                 
                        With ActiveChart ' 書式設定
                            .HasLegend = False
                            .SeriesCollection(1).MarkerStyle = xlMarkerStyleNone ' -4142
                            .Axes(xlValue).HasMajorGridlines = False
                            
                            Call Y_AXIS(yMin, yMax, yMgn)
                            .Axes(xlValue).TickLabelPosition = xlLow
                            .Axes(xlValue).Format.Line.Visible = msoFalse
                            
                            Call X_AXIS(xMin, xMax, xMgn)
                            .Axes(xlCategory).TickLabelPosition = xlNone
                            .Axes(xlCategory).Format.Line.Visible = msoFalse
                            
                            .SetElement (msoElementPrimaryValueGridLinesMajor) ' 主軸目盛り線の挿入
                        End With
                    End If
                    
                    If y = v Then ' x方向のラベル(グラフオブジェクト)を作る
                        ActiveSheet.Shapes.AddChart(xlXYScatter, axLeft + x * paWidth, axTop + y * paHeight + adjX, _
                            paWidth, paHeight).Select ' 引数：Left top width height
                        ActiveChart.SetSourceData Source:=Range(param1 & "," & param2) ' データ範囲の指定
                            yMgn = Margin(yMin, yMax) ' y軸マージン量の決定
                            xMgn = Margin(xMin, xMax) ' x軸マージン量の決定
                        
                        With ActiveChart
                            .HasLegend = False
                            .SeriesCollection(1).MarkerStyle = xlMarkerStyleNone ' -4142
                            .Axes(xlValue).HasMajorGridlines = False
                            
                            Call Y_AXIS(yMin, yMax, yMgn)
                            .Axes(xlValue).TickLabelPosition = xlNone
                            .Axes(xlValue).Format.Line.Visible = msoFalse
                            
                            Call X_AXIS(xMin, xMax, xMgn)
                            .Axes(xlCategory).TickLabelPosition = xlLow
                            .Axes(xlCategory).Format.Line.Visible = msoFalse
                            
                            .Axes(xlCategory).TickLabels.Orientation = xlUpward ' ラベルを-90°回転
                            .SetElement (msoElementPrimaryCategoryGridLinesMajor) ' 主軸目盛り線の挿入
                        End With
                    End If
                    
                    ' 散布図の作成
                    ActiveSheet.Shapes.AddChart(xlXYScatter, axLeft + x * paWidth, axTop + y * paHeight, _
                        paWidth, paHeight).Select
                    ActiveChart.SetSourceData Source:=Range(param1 & "," & param2) ' データ範囲の指定
                        yMgn = Margin(yMin, yMax) ' y軸マージン量の決定
                        xMgn = Margin(xMin, xMax) ' x軸マージン量の決定
                    With ActiveChart
                        .HasLegend = False
                        .Axes(xlValue).HasMajorGridlines = False
                        
                        Call Y_AXIS(yMin, yMax, yMgn)
                        .Axes(xlValue).TickLabelPosition = xlNone
                        .Axes(xlValue).Delete ' 0線を削除(元データに正負の値が混在するとき 軸の描画が邪魔な場合の対処)
                        
                        Call X_AXIS(xMin, xMax, xMgn)
                        .Axes(xlCategory).TickLabelPosition = xlNone
                        .Axes(xlCategory).Delete ' 0線を削除(元データに正負の値が混在するとき 軸の描画が邪魔な場合の対処)
                    End With
                                   
                    ' プロットエリアの枠線の色を変更
                    ActiveChart.PlotArea.Select
                    Selection.Format.Line.Visible = msoFalse ' 枠線を不可視に
                    'Selection.Format.Line.ForeColor.RGB = RGB(153, 153, 153) ' 枠線ありの場合
                    ' マーカーの線色と塗り色を変更
                    With ActiveChart.SeriesCollection(1)
                        .MarkerBackgroundColorIndex = xlColorIndexNone ' 塗り色(デフォ：なし)
                        .MarkerForegroundColor = RGB(0, 0, 0) ' 線色
                    End With
                        
            Case Is > y ' 相関行列(マトリクスの右上部を描く)
            
                Set cor = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                axLeft + x * paWidth, axTop + y * paHeight, paWidth, paHeight) ' テキストボックスの作成
            
                With cor ' テキストボックスの書式設定
                    .TextFrame.Characters.Text = Format(r(y, x), "0.00") ' 相関係数をセット(.以下有効2桁)
                    '.TextFrame.Characters.Font.Size = 12 ' フォントサイズ[固定]
                    .TextFrame.Characters.Font.Size = Application.WorksheetFunction.Max(32 * Abs(r(y, x)), 10) ' フォントサイズ[可変](デフォ)
                    .TextFrame2.VerticalAnchor = msoAnchorTop
                    .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignRight
                    
                    ' ※※※ 相関係数の強弱に応じて背景を着色する
                    
                    'Select Case r(y, x)
                    '    Case Is > 0 ' 正の相関(赤)
                    '        .Fill.ForeColor.RGB = RGB(255, 255 * (1 - r(y, x)), 255 * (1 - r(y, x)))
                    '    Case 0 ' 無相関(白)
                    '        .Fill.ForeColor.RGB = RGB(255, 255, 255)
                    '    Case Is < 0 ' 負の相関(青)
                    '        .Fill.ForeColor.RGB = RGB(255 * (1 + r(y, x)), 255 * (1 + r(y, x)), 255)
                    'End Select
                    
                    ' ※※※ 相関係数の強弱に応じて背景を着色する ここまで
                    
                End With
            
            Case Is = y ' 変数名(マトリクスの中央対角部を描く)
            
                Set head = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                    axLeft + x * paWidth, axTop + y * paHeight, paWidth, paHeight) ' テキストボックスの作成
                With head ' テキストボックスの書式設定
                    .Fill.ForeColor.RGB = RGB(234, 234, 234) ' 背景色(うすいグレー)
                    .TextFrame.Characters.Text = header(x) ' 変数名を配置
                    '.TextFrame2.TextRange.Font.NameFarEast = "Meiryo UI" ' 使用フォント
                    .TextFrame2.VerticalAnchor = msoAnchorMiddle
                    .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
                End With
        
        End Select
        
    Next

Next
Application.ScreenUpdating = True
Exit Sub

myError:
    MsgBox "実行時エラーが発生しました。処理を終了します。"
    Application.ScreenUpdating = True
End Sub

Function Margin(Min As Double, Max As Double) As Double
' マージンの計算
Dim MinLength As Double ' 小数点以下の有効桁の抽出用
Dim MaxLength As Double
    If Min = Int(Min) Or Max = Int(Max) Then
        ' 小数点以下の情報を持たない場合の処理
        Margin = Application.WorksheetFunction.Round((Max - Min) * Ratio, 0)
    Else
        ' 小数点以下の情報を持つ場合の処理
        MinLength = Min - Int(Min)
        MaxLength = Max - Int(Max)
        If Len(MinLength) > Len(MaxLength) Then
            Margin = Application.WorksheetFunction.Round((Max - Min) * Ratio, Len(MinLength) - 2)
        Else
            Margin = Application.WorksheetFunction.Round((Max - Min) * Ratio, Len(MaxLength) - 2)
        End If
    End If
End Function

Private Sub X_AXIS(Min As Double, Max As Double, Mgn As Double)
' X軸の最大値と最小値の設定
    With ActiveChart
        .Axes(xlCategory).MinimumScale = Min - Mgn
        .Axes(xlCategory).MaximumScale = Max + Mgn
    End With
End Sub

Private Sub Y_AXIS(Min As Double, Max As Double, Mgn As Double)
' Y軸の最大値と最小値の設定
    With ActiveChart
        .Axes(xlValue).MinimumScale = Min - Mgn
        .Axes(xlValue).MaximumScale = Max + Mgn
    End With
End Sub

Sub SCATTERMATRIX2_combine()
' 図形のグループ化
Dim allShapes As ShapeRange

      ActiveSheet.Shapes.SelectAll
      Set allShapes = Selection.ShapeRange
      allShapes.Group.Select

End Sub

Step 4VBEの操作・VBAコードの導入(3)　コードの貼り付け

「標準モジュール」ウインドウにコードを貼り付けます。

Step 5VBEの操作・VBAコードの導入(4)

閉じるボタンをクリックしてVBEを閉じます。

マクロの実行

Step 6データ領域の選択

描画したい変数の，ひと続きのデータ範囲を列見出し(変数名)も含め選択します。

Step 7マクロの実行(1)

開発タブ「コード」グループのマクロボタンをクリックします。

Step 8マクロの実行(2)　“SCATTERMATRIX1_draw”

「マクロ」ダイアログが表示されます。

「マクロ名」に2つのマクロが表示されています。ここでは「SCATTERMATRIX1_draw」の方を選択して，実行ボタンをクリックします。

Step 9マクロの実行(3)

マクロ「SCATTERMATRIX1_draw」の処理が始まります。データ量ないしはPC等のスペックにしたがって，処理時間が必要となる場合があります。この処理によりあたらしいブックが作成され，ここに散布図行列がアウトプットされます。

Step 10目盛位置の確認

この散布図行列は見かけ上のみ単一で，実態は複数のばらばらのオブジェクト(Graph, Text Box)によって構成されています。

これは，かかる散布図両軸のラベルについても例外でなく，Graphオブジェクトを重ねることによって表現しています。したがって，値の桁数などによっては表示の見切れが生じる可能性があります。この場合，下の図のように個別のオブジェクトを引き出して表示を調整することができます(利用を繰り返すとき，初期設定の値がマッチしないのも都度の修正が面倒だと思います。このような場合，コードの先頭方向の定数adjY, adjXを任意で調整(増やすor減らす)してください)。

Step 11マクロの実行(4)

以上の手続きまでに作成されたアウトプットは，エクセルの他のシートないしはワード・パワーポイントで作る文書にコピー＆ペーストして利用することを想定しています。

ただ，この時点でこの散布図行列の構造は結びつきを持たない単独のオブジェクトであって，そうした想定を満たせるものとは言えません。このため，以下で若干の作業を加えます(画像化)。

Step 12マクロの実行(5)

あたらしく作成されたブックの方の，開発タブ「コード」グループのマクロボタンをクリックします。

Step 13マクロの実行(6)　“SCATTERMATRIX2_combine”

「マクロ」ダイアログが表示されます。

「マクロ名」に2つのマクロが表示されています。ここでは「［元のブックのファイル名］!SCATTERMATRIX2_combine」の方を選択して，実行ボタンをクリックします。

Step 14マクロの実行(7)

マクロが実行され，シート上にあるすべてのオブジェクトがグループ化されます。

Step 15図のコピー(1)

そのまま，ホームタブ「クリップボード」グループのコピーボタン右の三角をクリックし，図としてコピーを選択します。

Step 16図のコピー(2)

「図のコピー」ダイアログが表示されます。

＜表示＞を「画面に合わせる」，＜形式＞を「ピクチャ」にして，OKボタンをクリックします。

Step 17図の貼り付け(1)

任意の文書やシート(作成した散布図を用いるドキュメント)の当該箇所をアクティブにし，ホームタブ「クリップボード」グループの貼り付けボタンをクリックします。

Step 18図の貼り付け(2)・完成

図のハンドルを操作し，任意の大きさに整えて完成です。

拡張

相関の強弱表現

コードの中の「※」マークで囲まれた領域のコメントアウトを解除して実行すると，相関係数の大きさに応じてテキストボックス(右上半分)の背景色を変更する仕様となります(下図)。

この場合の色の割り当てはRGB(0, 0, 255)～(255, 255, 255)～(255, 0 0)としています(下図)。

[-1]青～[0]白～[1]赤

散布図行列を出力できるExcelアドインソフト

エクセル統計 BellCurve

「基本統計・相関」「散布図行列」

その他の参照

このサイトの関連How-toです。

メインサイト「ひとりマーケティングのためのデータ分析」の相関に関するHow-toです。

Home

BDAstyle

Business Data Analysis & Visualization with Excel

散布図行列の作成 with Excel VBA

イントロダクション

Step 0シチュエーションの設定

免責および特記事項

工程

コードの導入

Step 1VBE(Visual Basic Editor)の起動

Step 2VBEの操作・VBAコードの導入(1)

Step 3VBEの操作・VBAコードの導入(2)　コードのコピー

Step 4VBEの操作・VBAコードの導入(3)　コードの貼り付け

Step 5VBEの操作・VBAコードの導入(4)

マクロの実行

Step 6データ領域の選択

Step 7マクロの実行(1)

Step 8マクロの実行(2)　“SCATTERMATRIX1_draw”

Step 9マクロの実行(3)

Step 10目盛位置の確認

Step 11マクロの実行(4)

Step 12マクロの実行(5)

Step 13マクロの実行(6)　“SCATTERMATRIX2_combine”

Step 14マクロの実行(7)

Step 15図のコピー(1)

Step 16図のコピー(2)

Step 17図の貼り付け(1)

Step 18図の貼り付け(2)・完成

拡張

相関の強弱表現

散布図行列を出力できるExcelアドインソフト

その他の参照

散布図行列の作成 with Excel VBA

イントロダクション

Step 0シチュエーションの設定

免責および特記事項

工程

コードの導入

Step 1VBE(Visual Basic Editor)の起動

Step 2VBEの操作・VBAコードの導入(1)

Step 3VBEの操作・VBAコードの導入(2) コードのコピー

Step 4VBEの操作・VBAコードの導入(3) コードの貼り付け

Step 5VBEの操作・VBAコードの導入(4)

マクロの実行

Step 6データ領域の選択

Step 7マクロの実行(1)

Step 8マクロの実行(2) “SCATTERMATRIX1_draw”

Step 9マクロの実行(3)

Step 10目盛位置の確認

Step 11マクロの実行(4)

Step 12マクロの実行(5)

Step 13マクロの実行(6) “SCATTERMATRIX2_combine”

Step 14マクロの実行(7)

Step 15図のコピー(1)

Step 16図のコピー(2)

Step 17図の貼り付け(1)

Step 18図の貼り付け(2)・完成

拡張

相関の強弱表現

散布図行列を出力できるExcelアドインソフト

その他の参照

Step 3VBEの操作・VBAコードの導入(2)　コードのコピー

Step 4VBEの操作・VBAコードの導入(3)　コードの貼り付け

Step 8マクロの実行(2)　“SCATTERMATRIX1_draw”

Step 13マクロの実行(6)　“SCATTERMATRIX2_combine”