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

　下記記事にて、複数のデータファイルを1つのExcelファイルに集約させるマクロを紹介した。

　前回はデータを集めるだけで終わったが、今回はそれに加えて必要なデータのみを抽出し、1つのシートにまとめて表示させるようにする。

サンプル

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

　圧縮ファイル内のマクロ「exp5_comp.xlsm」のベースは、前回作成したデータファイルの取得マクロと同じである。

　メッセージボックスに関するコードについてはこちらを参照。

　

　今回のマクロ「exp5_comp.xlsm」を開くと、Sheet1が下図のように表示される。

　今までと同じように「データファイルの取得とデータ抽出および表示」のボタンを押してデータファイルを取得すると、下図のようになる。

　これまではデータファイルごとにシートが追加され、Sheet1にはデータファイルの名前とシートへのリンクが貼れらていたが、今回はそれに加えて右側に数値が並んでいる。

　これらの数値は、各データシート上の数値データの内、Sheet1のセルC6～G6に書かれているセルに入力されている数値を引っぱってきたものだ。

　例えばE6には「C3」と入力されているため、E列には各データシートのセルC3の数値が並ぶようになっている。

　このSheet1の6行目に書かれているセル番地は任意に変えることもできる。

　さらにデフォルトではセルG6までしか記入されていないが、セルG6より右のセルにセル番地を追記しても、ちゃんとデータシートからそのセルの数値を抽出するようになっている。

　

　今回はこの必要なデータを抽出し、1つのシートにまとめて表示させるコードを中心に解説し、それ以外のコードの詳細については上記記事を参照してもらうことにする。

コード詳説

　今回解説するのは、下記コードの太字の部分である。

　この太字の部分が、データの抽出と表示を実行している部分になる。

Sub データファイルの取得とデータ抽出および表示()

    Dim FD As FileDialog
    Dim FolderPath As String
    Dim myFile As String
    Dim FileEx As String
    Dim i As Long
    Dim j As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    FileEx = Worksheets(1).Cells(3, 7).Value
    Set FD = Application.FileDialog(msoFileDialogFolderPicker)
    
    If FileEx = "" Then
    
        MsgBox "データファイルの拡張子を指定してください。", vbExclamation
        
    ElseIf FD.Show = True Then
        FolderPath = FD.SelectedItems(1)
        myFile = Dir(FolderPath & "\*." & FileEx)
        i = Worksheets.Count
        j = Worksheets.Count
        
        If FileEx <> "" Then
        Do While myFile <> ""
           
            Workbooks.OpenText Filename:=FolderPath & "\" & myFile
            Cells.Select
            Selection.Copy
            ActiveWindow.Close
            
            Sheets.Add After:=Worksheets(i)
            
            With Worksheets(i + 1)
                .Name = myFile
                .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(i + 7, 2), _
                                        Address:="", _
                                        SubAddress:="'" & Worksheets(i + 1).Name & "'" & "!A1", _
                                        TextToDisplay:=Worksheets(i + 1).Name
            End With
            
            Worksheets(1).Cells(6, 3).Select
            
            Do While ActiveCell.Value <> ""
            
                Worksheets(1).Cells(i + 7, ActiveCell.Column).Value = _
                Worksheets(i + 1).Range(ActiveCell.Value).Value
            
                ActiveCell.Offset(0, 1).Select
            
            Loop
            
            myFile = Dir()
            i = i + 1
        Loop
        
        End If
        
        If FileEx <> "" And i = j Then
            MsgBox "指定した拡張子のファイルがありません。", vbExclamation
        End If
        
    End If
    
    Worksheets(1).Cells(1, 1).Select
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

　

　まずは

            Worksheets(1).Cells(6, 3).Select

でSheet1のセルC6を選択する。

　次にDo While ～ Loop構文で必要なデータの抽出と表示を繰り返していく。

            Do While ActiveCell.Value <> ""
            
                Worksheets(1).Cells(i + 7, ActiveCell.Column).Value = _
                Worksheets(i + 1).Range(ActiveCell.Value).Value
            
                ActiveCell.Offset(0, 1).Select
            
            Loop

　まずDo While ～ Loop構文の中身を見ていくと、1,2行目は1つのコードであり、長いコードだがやっていることはセルへの値の代入である。

　代入される側のセルは、Sheet1のi+7行目かつアクティブセルと同じ列にあるセルである。

　代入元となるセルは、i+1番目のシートの、現在アクティブになっているセルに書かれているセルである。

　値の代入後は、アクティブセルを右に1つ移動する。

　そしてこの一連の処理を、「ActiveCell.Value <> “”」すなわちアクティブセルが空白にならない間は続けていく。

終わりに

　今回は、取り込んだデータから必要なデータを抽出して表示するコードを追加した。

　これでデータ抽出してまとめる手間も省けたことになる。

　ここからのデータの扱いやまとめ方は人によって変わってくると思うので、この抽出したデータに何か手を加えることはしない予定だ。

　次回は今回のデータ抽出と表示はしない代わりに、データをグラフ化して1つのシートにまとめるマクロをつくろうと思う。

　

　END