【Excelマクロ】チェックボックスで指定したデータのみグラフを描画

　またまたデータ取り込み&グラフ描画に手を加えた。

　仕事中に取り込んだデータから任意に選択したデータのみグラフ化したいと思い、チェックボックスを導入してチェックが付いたデータのみグラフ化するようにした。

Microsoft Excel 2019の利用を想定しています。

サンプル
コード詳説
終わりに

サンプル

　今回使うサンプルは下記ボタンから入手可能である。

Excel_Macro_Sample_12.zip ↓

　マクロ本体「exp12_comp.xlsm」を開くと、下のようなウィンドウが表示される。

　基本的な使い方は下記記事とほぼ同じである。

【Excelマクロ】データファイルをシートに取り込み Ver.2

マクロをやり始めて間もない頃に、データファイルをExcelファイルに一括取り込みするマクロを作成し、他のマクロにも併用してきた。　このマクロはデータファイルが入っているフォルダとデータファイルのファイル形式を指定し、同じフォルダ内の同じフ...

　しかし今回は「データファイル取得」からデータを取り込むと、A7セルの「グラフ表示」以降にチェックボックスが出現する。

　このチェックボックスをONにして「グラフ作成」をクリックすると、チェックボックスがONになっているデータのみがグラフ描画される。

　またチェックボックスの追加に伴い、マクロを動かすボタンが2つ追加されている。

　「全データ選択」ボタンはチェックボックス全てをONに、「全データ選択解除」ボタンはチェックボックスを全てOFFにする。

コード詳説

　「exp12_cpmp_xlsm」には7つのマクロが保存されている。

　いつも通り、以前別記事で解説したマクロについては本記事での解説を省略し、新たに追加したマクロ、コードのみ解説していく。

データファイル取得

　「データファイル取得」マクロの中身は下記のようになっている。

Sub データファイルの取得()

    Dim FD As FileDialog
    Dim i As Long
    Dim j As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set FD = Application.FileDialog(msoFileDialogFilePicker)
    FD.AllowMultiSelect = True
    
    j = Worksheets.Count
    
    If FD.Show = True Then
    
        For i = 1 To FD.SelectedItems.Count

            Workbooks.OpenText Filename:=FD.SelectedItems(i)
            Cells.Select
            Selection.Copy
            ActiveWindow.Close
            
            Sheets.Add After:=Worksheets(j)
            
            With Worksheets(j + 1)
                .Name = Dir(FD.SelectedItems(i))
                .Paste
                .Hyperlinks.Add Anchor:=Cells(1, 5), _
                                        Address:="", _
                                        SubAddress:="'" & Worksheets(1).Name & "'" & "!A1", _
                                        TextToDisplay:=Worksheets(1).Name
                .Cells(1, 1).Select
            End With
                                      
            With Worksheets(1)
                .Activate
                .Hyperlinks.Add Anchor:=Cells(j + 7, 2), _
                                        Address:="", _
                                        SubAddress:="'" & Worksheets(j + 1).Name & "'" & "!A1", _
                                        TextToDisplay:=Worksheets(j + 1).Name
                .OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
                               Width:=10, _
                               Height:=Cells(j + 7, 1).Height * 2 / 3, _
                               Top:=Cells(j + 7, 1).Top + (Cells(j + 7, 1).Height - Cells(j + 7, 1).Height * 2 / 3) / 2, _
                               Left:=Cells(j + 7, 1).Left + (Cells(j + 7, 1).Width - 10) / 2).Select
            End With
              
            j = j + 1
            
        Next
        
    End If
    
    Worksheets(1).Activate
    Worksheets(1).Range("A1").Select
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

　太字の部分が新たに追加したコードである。

　その他のコードについては下記記事を参照されたい。

【Excelマクロ】データファイルをシートに取り込み Ver.2

　今回追加したコード

.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
                               Width:=10, _
                               Height:=Cells(j + 7, 1).Height * 2 / 3, _
                               Top:=Cells(j + 7, 1).Top + (Cells(j + 7, 1).Height - Cells(j + 7, 1).Height * 2 / 3) / 2, _
                               Left:=Cells(j + 7, 1).Left + (Cells(j + 7, 1).Width - 10) / 2).Select

は、シートへのリンクの隣にチェックボックスを追加するコードである。

Worksheets(i).OLEObjects.Add(ClassType:=”Forms.CheckBox.1″, Width=W, Height=H, Top=T, Left=L)
⇒　i番目のワークシート上に幅W、高さHのチェックボックスを、上端が縦方向の座標T、左端が横方向の座標Lの位置に来るように配置する。

データ抽出および表示

　下記記事を参照。

【Excelマクロ】各シートから欲しいデータを抽出・表示する方法

下記記事にて、複数のデータファイルを1つのExcelファイルに集約させるマクロを紹介した。　前回はデータを集めるだけで終わったが、今回はそれに加えて必要なデータのみを抽出し、1つのシートにまとめて表示させるようにする。 Microsoft...

全データ選択・全データ選択解除

　「全データ選択」マクロの中身は下記のようになっている。

Sub 全データ選択()

    Dim CB As Object
    
    For Each CB In Worksheets(1).OLEObjects
    CB.Object.Value = True
    Next

End Sub

　中身としてはシンプルで、For～Each構文で全てのチェックボックスを対象に挙げ、全てのチェックボックスの値が「True」、つまりチェックボックスがONになるようにしている。

　「全データ選択解除」マクロも「全データ選択」とコード自体はほぼ同じである。

Sub 全データ選択解除()

    Dim CB As Object
    
    For Each CB In Worksheets(1).OLEObjects
    CB.Object.Value = False
    Next

End Sub

　ただしチェックボックスの値を「False」にすることで、すべてのチェックボックスをOFFにするようにしている。

グラフ作成

　「グラフ作成」マクロの中身は下記のようになっている。

Sub グラフ作成()
    Dim GraphA As Shape
    Dim GraphB As Shape
    Dim i As Long
    Dim j As Long
    Dim Wmin As Variant
    Dim Wmax As Variant
    Dim Wmini As Variant
    Dim Wmaxi As Variant
    
    
    Set GraphA = Worksheets(1).Shapes.AddChart2(XlChartType:=xlXYScatterSmoothNoMarkers)
        With GraphA
         .Top = Worksheets(1).Range("H6:M6").Top
         .Left = Worksheets(1).Range("H6:M6").Left
         .Width = Worksheets(1).Range("H6:M6").Width
         .Chart.ChartTitle.Text = Worksheets(1).Range("H3").Value
        End With
        
    Set GraphB = Worksheets(1).Shapes.AddChart2(XlChartType:=xlXYScatterSmoothNoMarkers)
        With GraphB
         .Top = Worksheets(1).Range("H18:M18").Top
         .Left = Worksheets(1).Range("H18:M18").Left
         .Width = Worksheets(1).Range("H18:M18").Width
         .Chart.ChartTitle.Text = Worksheets(1).Range("I3").Value
        End With
    
    
    For i = 2 To Worksheets.Count
        
        j = 1
        Do Until IsNumeric(Worksheets(i).Cells(j, 1)) = True And Worksheets(i).Cells(j, 1).Value <> "" _
             And IsNumeric(Worksheets(i).Cells(j + 1, 1)) = True And Worksheets(i).Cells(j + 1, 1).Value <> "" _
             And IsNumeric(Worksheets(i).Cells(j + 2, 1)) = True And Worksheets(i).Cells(j + 2, 1).Value <> "" _
             And IsNumeric(Worksheets(i).Cells(j + 3, 1)) = True And Worksheets(i).Cells(j + 3, 1).Value <> "" _
             And IsNumeric(Worksheets(i).Cells(j + 4, 1)) = True And Worksheets(i).Cells(j + 4, 1).Value <> ""
             
             j = j + 1
             
        Loop
    
        With GraphA.Chart
            .SeriesCollection.NewSeries
            .FullSeriesCollection(i - 1).Name = Worksheets(1).Cells(i + 6, 3).Value
            .FullSeriesCollection(i - 1).XValues = Worksheets(i).Range(Worksheets(i).Cells(j, 1), Worksheets(i).Cells(j, 1).End(xlDown))
            .FullSeriesCollection(i - 1).Values = Worksheets(i).Range(Worksheets(i).Cells(j, 2), Worksheets(i).Cells(j, 2).End(xlDown))
            If Worksheets(1).OLEObjects("CheckBox" & i - 1).Object.Value = True Then
                .FullSeriesCollection(i - 1).IsFiltered = False
            Else
                .FullSeriesCollection(i - 1).IsFiltered = True
            End If
        End With
        
        With GraphB.Chart
            .SeriesCollection.NewSeries
            .FullSeriesCollection(i - 1).Name = Worksheets(1).Cells(i + 6, 3).Value
            .FullSeriesCollection(i - 1).XValues = Worksheets(i).Range(Worksheets(i).Cells(j, 1), Worksheets(i).Cells(j, 1).End(xlDown))
            .FullSeriesCollection(i - 1).Values = Worksheets(i).Range(Worksheets(i).Cells(j, 3), Worksheets(i).Cells(j, 3).End(xlDown))
            If Worksheets(1).OLEObjects("CheckBox" & i - 1).Object.Value = True Then
                .FullSeriesCollection(i - 1).IsFiltered = False
            Else
                .FullSeriesCollection(i - 1).IsFiltered = True
            End If
        End With
        
        
        Wmaxi = WorksheetFunction.Max(Worksheets(i).Range(Worksheets(i).Cells(j, 1), Worksheets(i).Cells(j, 1).End(xlDown)))
        If Wmaxi <> Int(Wmaxi) Then
            Wmaxi = Int(Wmaxi) + 1
        End If
        
        If i = 2 Then
            Wmax = Wmaxi
        ElseIf Wmax < Wmaxi Then
            Wmax = Wmaxi
        End If
        
        
        Wmini = Int(WorksheetFunction.Min(Worksheets(i).Range(Worksheets(i).Cells(j, 1), Worksheets(i).Cells(j, 1).End(xlDown))))
        
        If i = 2 Then
            Wmin = Wmini
        ElseIf Wmin > Wmini Then
            Wmin = Wmini
        End If
        
    Next
    
    
    i = Worksheets.Count
    Do While GraphA.Chart.FullSeriesCollection.Count <> Worksheets.Count - 1
        GraphA.Chart.FullSeriesCollection(i).Delete
    Loop
    
    i = Worksheets.Count
    Do While GraphB.Chart.FullSeriesCollection.Count <> Worksheets.Count - 1
        GraphB.Chart.FullSeriesCollection(i).Delete
    Loop
    

    
    With GraphA.Chart
         .Axes(xlCategory).MinimumScale = Wmin
         .Axes(xlCategory).MaximumScale = Wmax
         .Axes(xlCategory, xlPrimary).HasTitle = True
         .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Worksheets(1).Range("L3").Value
         .Axes(xlValue, xlPrimary).HasTitle = True
         .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Worksheets(1).Range("J3").Value
         .SetElement (msoElementLegendRight)
    End With
    
    
    With GraphB.Chart
         .Axes(xlCategory).MinimumScale = Wmin
         .Axes(xlCategory).MaximumScale = Wmax
         .Axes(xlCategory, xlPrimary).HasTitle = True
         .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Worksheets(1).Range("L3").Value
         .Axes(xlValue, xlPrimary).HasTitle = True
         .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Worksheets(1).Range("K3").Value
         .SetElement (msoElementLegendRight)
    End With

    
End Sub

　大きく分けると、変更点が1つ、追加点が1つある。

　変更点は、データ系列を参照する「SerisesCollection」のほとんどを「FullSeriesCollection」に変更したことである。

　両者の違いは、フィルターで除外されたデータ系列を含むか否かにある。

SerisesCollection
⇒　フィルターで除外されていない(グラフ表示がONになっている)データ系列のみ操作。

FullSeriesCollection
⇒　フィルターで除外されている(グラフ表示がOFFになっている)データ系列を含む全てのデータ系列を操作。

　下図において、チェックがついているデータ系列のみを扱うのが「SeriesCollection」、チェックが付いていないデータ系列を含めすべてのデータ系列を扱うのが「FullSeriesCollection」である。

　追加点は、チェックボックスのON/OFFでグラフの表示/非表示を切り替えるコードを挿入したことである。

If Worksheets(1).OLEObjects("CheckBox" & i - 1).Object.Value = True Then
    .FullSeriesCollection(i - 1).IsFiltered = False
Else
    .FullSeriesCollection(i - 1).IsFiltered = True
End If

　チェックボックスの値が「True」、すなわちチェックボックスがONならグラフを表示、チェックボックスの値が「False」、すなわちチェックボックスがOFFならグラフを非表示にする。

(変数).Chart.FullSeriesCollection(i).IsFiltered = True/False
⇒　変数に格納したグラフのi番目のデータ系列のグラフを、「True」なら非表示、「False」なら表示する。

データファイル転記シートおよびグラフの削除

　「データファイル転記シートおよびグラフの削除」マクロの中身は下記のようになっている。

Sub データファイル転記シートおよびグラフの削除()

    Dim i As Long
    Dim shp As Shape
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Do While Worksheets.Count <> 1
        Worksheets(2).Delete
    Loop
    
    Worksheets(1).Range("B8", ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Clear
    
    For Each shp In Worksheets(1).Shapes
    If shp.Type = msoChart Or shp.Type = msoOLEControlObject Then
    shp.Delete
    End If
    Next
    
    Worksheets(1).Range("A1").Select
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

　以前作成したマクロとほとんど変わらないが、図表削除のコード

For Each shp In Worksheets(1).Shapes
If shp.Type = msoChart Or shp.Type = msoOLEControlObject Then
shp.Delete
End If
Next

のみ太字部分を追加して、チェックボックスをグラフと一緒に削除している。

　その他のコードについては下記記事を参照。

【Excelマクロ】取り込んだデータからグラフを描画

以前、複数のデータファイルを1つのExcelファイルに集約させるマクロや、　必要なデータのみを抽出し、1つのシートにまとめて表示させるマクロを作ってきた。　今回は時系列データなどを取り込んで、グラフを描画するマクロを作ったので紹介する...

グラフ削除

　下記記事を参照。

【Excelマクロ】取り込んだデータからグラフを描画

終わりに

　最近仕事の都合でマクロを扱う機会が少なくなり、ネタがなくなってきた。

　マクロだけでなくPythonもやりたいし、他にもやりたいことが多い。

　なんか久々に本屋でじっくり本を吟味してみたい衝動に駆られている…

　引越先にも本屋はあるのだが、ジュンク堂レベルの大型書店で時間が許す限り本を見たい…

　END