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

Excelマクロ

 マクロをやり始めて間もない頃に、データファイルをExcelファイルに一括取り込みするマクロを作成し、他のマクロにも併用してきた。

 このマクロはデータファイルが入っているフォルダとデータファイルのファイル形式を指定し、同じフォルダ内の同じファイル形式のデータファイルのみを取り込むものだった。

 今回はこのマクロに手を加え、ファイル形式に囚われず、ダイアログ上で直接選択したデータファイルを取り込むようにしてみた。

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

サンプル

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

 圧縮ファイルの中身は前回とほぼ変わらず、マクロ有効のファイル「exp8_comp.xlsm」のみ異なる。

 

 まず「exp8_comp.xlsm」を開くと、次のような画面になる。

 最初に作成したファイルと比較すると、データファイルの拡張子を指定する部分が削除されている。

 左上の「データファイルの取得」ボタンをクリックすると、下のように[参照]ダイアログボックスが開く。

 ここで、解凍したフォルダ「Excel_Macro_Sample_8」の中に入るとフォルダの中身が閲覧できる。 
 (前回はフォルダの[参照]ダイアログボックスだったため、フォルダの中身を確認することが出来なかった。)

 取り込みたいデータファイルを1つ、または複数選択し「OK」をクリックする。

 すると、「exp9_comp.xlsm」に選択したデータファイルが次々に取り込まれる。

 前回は同一のファイル形式でないと取り込めなかったが、今回は異なるファイル形式のファイルを複数取り込むことが可能である。

 このように、取り込むファイルを直接選択でき、かつファイル形式の種類に制限されないようにしたのが今回の変更点である。

コード詳説

 今回手を加えたマクロ「データファイルの取得」を下記に示す。

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
            End With
              
            j = j + 1
            
        Next
        
    End If
    
    Worksheets(1).Activate
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

 今回はマクロの変更箇所の解説にとどめる。

 その他については下記を参照。

 

 まず、ダイアログの種類を[フォルダ参照]から[ファイル参照]に変更した。

    Set FD = Application.FileDialog(msoFileDialogFilePicker)
    FD.AllowMultiSelect = True

 FileDialogの引数が「msoFileDialogFolderPicker」から「msoFileDialogFilePicker」に変更されている。

 また、ファイルの複数選択を可能にするコードを追加した。

 

 続いて変数jにワークシートの数を代入し、iをファイル数カウント用変数としてデータファイルを取り込む繰り返し処理をスタートさせる。

    j = Worksheets.Count
    
    If FD.Show = True Then
    
        For i = 1 To FD.SelectedItems.Count

            Workbooks.OpenText Filename:=FD.SelectedItems(i)

 繰り返し処理の最初は選択したファイルを開く処理である。

 今回は「FD.SelectedItems(i)」に、i番目のファイルパスが拡張子込みでそのまま格納されている。

 

 あとは最初に作成したマクロと大差ない。

 開いたファイルの中身をコピーし、ワークシートを新規作成して貼り付ける処理を繰り返す。

終わりに

 前回のマクロと今回のマクロで優劣がつく、ということはない。

 例えば同じファイル形式のファイルを多数取り込みたい場合は前者、複数のファイル形式が入り混じったファイル群を数個取り込む場合は後者の方が使い勝手が良い。

 今は私も場面に応じてマクロを作り変えて仕事などに対応しているが、できればアプリ形式で、多様な場面で幅広く柔軟に使えるマクロを作りたい。

 せっかくある程度の構築スキルがついてきたから、なるべく早くそのレベルに到達したい…

 

 END

コメント

タイトルとURLをコピーしました