静粛に、只今統計勉強中

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

Excel VBAで層別散布図を作成するマクロを作ってみた2

前回、2通りある層別散布図の作成方法から、「系列を追加する」方法を選択してマクロを作ることにしました。記事の段取りはいつもどおりです。

 

ソースコード

'層別散布図を作成する
Sub Stratified_Scatter_Plot()
    
    Dim i As Integer, j As Integer
    Dim RNG(3) As Range
    Dim ChrtRow As Long
    Dim ChrtClm(1 To 3) As String
    Dim ChrtSrc(1 To 2) As String
    
    If Selection.Count <> 3 Then
        MsgBox "セルは必ず3つ選択してください。", vbCritical, "層別散布図"
    ElseIf Selection.Row <> 1 Then
        MsgBox "セルは必ず一行目(タイトル行)を選択してください。", vbCritical, "層別散布図"
    Else
        For Each RNG(0) In Selection
            i = i + 1
            Set RNG(i) = RNG(0)
        Next
        
        With ActiveSheet.Sort
            .SortFields.Clear
            .SortFields.Add Key:=RNG(1)
            .SetRange RNG(1).CurrentRegion
            .Header = xlYes
            .Apply
        End With
        
        ChrtRow = 2: j = 1
        For i = 1 To 3
            ChrtClm(i) = Left(RNG(i).Address, 3)
        Next
        For i = 3 To RNG(1).End(xlDown).Row + 1
            If Cells(i, RNG(1).Column).Value <> Cells(i - 1, RNG(1).Column).Value Then
                ChrtSrc(1) = "'" & ActiveSheet.Name & "'!" & ChrtClm(2) & ChrtRow & _
                    ":" & ChrtClm(2) & i - 1
                ChrtSrc(2) = "'" & ActiveSheet.Name & "'!" & ChrtClm(3) & ChrtRow & _
                    ":" & ChrtClm(3) & i - 1
                If ChrtRow = 2 Then
                    ActiveSheet.Shapes.AddChart2(240, xlXYScatter).Select
                    ActiveChart.SetSourceData Source:=Range(ChrtSrc(1) & "," & ChrtSrc(2))
                    ActiveChart.FullSeriesCollection(1).Name = _
                        "='" & ActiveSheet.Name & "'!" & ChrtClm(1) & ChrtRow
                Else
                    j = j + 1
                    With ActiveChart
                        .SeriesCollection.NewSeries
                        .FullSeriesCollection(j).Name = _
                            "='" & ActiveSheet.Name & "'!" & ChrtClm(1) & ChrtRow
                        .FullSeriesCollection(j).XValues = "=" & ChrtSrc(1)
                        .FullSeriesCollection(j).Values = "=" & ChrtSrc(2)
                    End With
                End If
                ChrtRow = i
            End If
        Next
        
        With ActiveChart
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Text = RNG(2).Value
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Text = RNG(3).Value
            .SetElement (msoElementLegendRight)
        End With
        
    End If

End Sub

 

コードのポイント解説

With ActiveSheet.Sort
    .SortFields.Clear
    .SortFields.Add Key:=RNG(1) .SetRange RNG(1).CurrentRegion
    .Header = xlYes
    .Apply
End With

まず、属性の列をキーとしてデータを並べ替えます。
なるべく元データを弄りたくはありませんが、これだけは必須なので。

For i = 3 To RNG(1).End(xlDown).Row + 1
    If Cells(i, RNG(1).Column).Value <> Cells(i - 1, RNG(1).Column).Value Then

3行目から最終行+1行目までのループの中で、キー列(属性)の値が変わる境目で処理を実行します。

If ChrtRow = 2 Then
    ActiveSheet.Shapes.AddChart2(240, xlXYScatter).Select
    ActiveChart.SetSourceData Source:=Range(ChrtSrc(1) & "," & ChrtSrc(2))
    ActiveChart.FullSeriesCollection(1).Name = _
        "='" & ActiveSheet.Name & "'!" & ChrtClm(1) & ChrtRow
Else
    j = j + 1
    With ActiveChart .SeriesCollection.NewSeries
        .FullSeriesCollection(j).Name = _
            "='" & ActiveSheet.Name & "'!" & ChrtClm(1) & ChrtRow
        .FullSeriesCollection(j).XValues = "=" & ChrtSrc(1)
        .FullSeriesCollection(j).Values = "=" & ChrtSrc(2)
    End With
End If

1番目の属性のデータ範囲でグラフ(散布図)を作成します。
2番目以降の属性のデータ範囲で系列を追加します。

With ActiveChart
    .Axes(xlCategory, xlPrimary).HasTitle = True
    .Axes(xlCategory, xlPrimary).AxisTitle.Text = RNG(2).Value
    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Text = RNG(3).Value
    .SetElement (msoElementLegendRight)
End With

 最後に、軸ラベルと凡例を追加します。

 

使い方と実行結果

使用上の注意
  1. 1行目は必ずタイトル行にしてください。
  2. 属性の列は必ず一番左に配置してください。
  3. 属性の列に欠損値があると正常に動作しません。 
使い方
  1. ソースコード全行をVBEで標準モジュールにコピペししてください。
  2. 1行目(タイトル行)でセルを3つ選択してください。
    左:属性  真ん中:横軸  右:縦軸  となります。
    f:id:cyclo-commuter:20180605104223p:plain
  3. [開発]→[マクロ]→[Stratified_Scatter_Plot]を選択→【実行】をクリックしてください。
    f:id:cyclo-commuter:20180606102230p:plain
実行結果

f:id:cyclo-commuter:20180606102832p:plain

一瞬で、層別散布図が作成されます。

書式とかは適宜、手を加えてください。