【ExcelVBA】同じ構造の表を持つ複数のExcelファイルから条件に合致したデータを取得するには

この記事では、同じ構造の表を持つ複数のExcelファイルから条件に合致したデータを取得する方法についてご説明します。

【動画】同じ構造の表を持つ複数のExcelファイルから条件に合致したデータを取得する実際の動き

本題に入る前に、まずは次の動画をご覧ください。


まず同じ構造の表を持つ複数のExcelファイルから、その表をマクロ側のExcelファイルに取り込みます。

その次にSELECT文を実行して取り込んだ表に対して合致するデータを抽出しています。

Excelファイルの例

マクロ側のExcelファイル

今回は次のExcelファイルを用意しました。

シート「top」のセルA2には「folderNM」という名前を付けており、このセルに同じ構造の表を持つ複数のExcelファイルの格納先を入力します。

セルA5には「lName」という名前を付けており、このセルに検索の条件を入力します。(今回のサンプルでは市区町村名を検索条件にしています)

シート「work」は検索した結果該当するデータが出力されるシートです。

出力結果は「動作確認」をご確認ください。

同じ構造の表を持つ複数のExcelファイル

今回はサンプル用に関東にある郵便局の一覧を用意しました。

以下のデータをマクロがExcelファイルに取り込みます。

マクロ作成の流れ

STEP.1
同じ構造の表を持つ複数のExcelファイルから、その表をマクロ側のExcelファイルに取り込む
同じ構造の表を持つ複数のExcelファイルから、その表をマクロ側のExcelファイルに取り込みます。
STEP.2
STEP.1の全ての表に対し、UNION ALLで結合させてから検索条件に合致するSELECT文を用意する
STEP.1の全ての表に対し、UNION ALLで結合させてから検索条件に合致するSELECT文を用意します。
STEP.3
STEP.2のSELECT文を実行し、合致したデータをExcelのシートに出力する
STEP.2のSELECT文を実行し、合致したデータをExcelのシートに出力します。

コードの例

Excelのマクロのコード(例)

Option Explicit

Private Sub btn_findData_Click()

    Dim filePath            As String               'データが入力されているExcelファイルの格納先
    Dim conn                As ADODB.Connection     'ADODB.Connectionオブジェクトのインスタンス用変数
    Dim rs                  As ADODB.Recordset      'レコードセット用変数
    Dim fso                 As FileSystemObject     'FileSystemObjectのインスタンス用変数
    Dim ws                  As Worksheet            'Worksheet用変数
    Dim excelFile           As File                 'Excelファイル(パスあり)
    Dim excelFile_np        As String               'Excelファイル(パス無し)
    Dim pstDdSheetNM        As String               'データを貼り付ける先のシート名
    Dim cnt                 As Long                 'カウンタ
    Dim tblRangAry()        As String               '表の範囲用配列
    Dim excelFlLstColPos    As String               'excelファイルにある表の最後列の位置
    Dim rng                 As Range                'Rangeオブジェクト格納用変数
    Dim sqlStr              As String               'SQL文用変数
    
    'データが入力されているExcelファイルの格納先を取得する
    filePath = Worksheets("top").Range("folderNM").Value
                
    'FileSystemObjectのインスタンスを生成する
    Set fso = New FileSystemObject
                
    'Connectionインスタンスの生成
    Set conn = New ADODB.Connection
            
    'Recordsetオブジェクトのインスタンスを生成する
    Set rs = New ADODB.Recordset
    
    'ブック内のシートの数分ループ
    For Each ws In Worksheets
    
        Select Case ws.Name
                
            Case "top", "work"
            
                'シート「top」「work」の場合は何もしない
            
            Case Else
            
                'シート「top」「work」以外の場合
            
                'メッセージを表示させないよう設定
                Application.DisplayAlerts = False
                
                'シートを削除する
                ws.Delete
                
                'メッセージを表示させない設定を解除
                Application.DisplayAlerts = True

        End Select

    Next ws

    'Excelファイルの数分ループさせる
    For Each excelFile In fso.GetFolder(filePath).Files
             
        'データを貼り付ける先のシート名を取得する
        pstDdSheetNM = Replace(Split(excelFile, ".")(0), filePath & "\", "")
        
        'パスを除いたexcelファイル名を取得する
        excelFile_np = pstDdSheetNM & "." & Split(excelFile, ".")(1)
        
        'データを貼り付ける先のシートを新規作成する
        Worksheets.Add(After:=Worksheets(Worksheets.Count)) _
                       .Name = pstDdSheetNM
        
        With conn
        
            '接続情報の取得(自分自身のExcelファイルに接続する)
            .Provider = "Microsoft.ACE.OLEDB.12.0"
            .ConnectionString = "Data Source = " & excelFile & _
            ";Extended Properties =Excel 12.0;"
            
            'データソースへの接続を開く
            .Open
            
        End With
            
        'Recordsetを開く(表の件数と列数取得)
        rs.Open " [" & "data$" & "]", conn, adOpenStatic
        
        '配列の最後の次元の要素数を変更する
        '→要素数を1つ拡張する
        ReDim Preserve tblRangAry(cnt)
        
        'excelファイルにある表の最後列の位置
        excelFlLstColPos = Split(Sheets("work").Cells(1, rs.Fields.Count).Address, "$")(1)
        
        'excelの表の範囲を取得する
        tblRangAry(cnt) = "[" & pstDdSheetNM & "$A1:" & excelFlLstColPos & rs.RecordCount + 1 & "]"
                
        With Worksheets(pstDdSheetNM)
            
            '表の範囲を取得する
            Set rng = .Range(.Cells(1, 1), .Cells(rs.RecordCount + 1, rs.Fields.Count))
        
            'データを貼り付ける先のシートにデータを貼り付ける
            rng.Formula = "=if(ISBLANK('" & filePath & "\[" & excelFile_np & "]work'!A1), """",'" & filePath & "\[" & excelFile_np & "]work'!A1)"
                    
            '取得先のExcelファイルを参照している計算式がセルに入力されているので、値そのものを再入力する
             rng.Copy: rng.PasteSpecial Paste:=xlPasteValues
             
             'コピー状態を解除する
             Application.CutCopyMode = False
        
        End With
        
        'recordsetを閉じる
        rs.Close

        'Connectionを切断する
        conn.Close
        
        cnt = cnt + 1
                
    Next
    
    With conn

        '接続情報の取得(自分自身のExcelファイルに接続する)
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source = " & ThisWorkbook.FullName & _
        ";Extended Properties =Excel 12.0;"

        'データソースへの接続を開く
        .Open

    End With
    
    'SELECT文を用意する
    sqlStr = "Select"
    sqlStr = sqlStr & " *"
    sqlStr = sqlStr & " From"
    sqlStr = sqlStr & " ("
    sqlStr = sqlStr & " Select"
    sqlStr = sqlStr & " *"
    sqlStr = sqlStr & " From"
    sqlStr = sqlStr & " " & tblRangAry(0)
    
    '表をUNION ALLで結合する
    For cnt = 1 To UBound(tblRangAry)
    
        sqlStr = sqlStr & " UNION ALL"
        sqlStr = sqlStr & " Select"
        sqlStr = sqlStr & " *"
        sqlStr = sqlStr & " From"
        sqlStr = sqlStr & " " & tblRangAry(cnt)
        
    Next
    
    sqlStr = sqlStr & " )"
    sqlStr = sqlStr & " as info"
    sqlStr = sqlStr & " Where"
    sqlStr = sqlStr & " 市区町村名 like '%" & Worksheets("top").Range("lName").Value & "%'"
    
    'Recordsetを開く
    rs.Open sqlStr, conn, adOpenStatic
    
    If CInt(rs.RecordCount) > 0 Then
    
        '検索データが0件よりも多い場合
    
        'データを出力するセルをクリアする
        Worksheets("work").Cells.Clear
    
        '表の列数分だけ処理をループする
        For cnt = 0 To rs.Fields.Count - 1
    
            '表の列名をセルに出力する
            Worksheets("work").Cells(1, 1 + cnt).Value = rs.Fields.Item(cnt).Name
    
        Next cnt
    
        '先ほど貼り付けた列名の下の行にデータを貼り付ける
        Worksheets("work").Cells(1, 1).Offset(1, 0).CopyFromRecordset rs
        
        'シート「top」を表示する
        Worksheets("work").Select
        
        'セルA1を選択する
        Worksheets("work").Range("A1").Select
    
        MsgBox "検索したデータが見つかりました。"
        
    Else
    
        '検索データが0件の場合
    
        'シート「top」を表示する
        Worksheets("top").Select
    
        MsgBox "検索したデータがありません。"
    
    End If

    'recordsetを閉じる
    rs.Close
    
    'Connectionを切断する
    conn.Close

    '後処理
    Set fso = Nothing
    Set conn = Nothing
    Set rs = Nothing
    
End Sub

注目すべきコード①

最初に見て頂きたいのは23行目から29行目です。

    'FileSystemObjectのインスタンスを生成する
    Set fso = New FileSystemObject
                
    'Connectionインスタンスの生成
    Set conn = New ADODB.Connection
            
    'Recordsetオブジェクトのインスタンスを生成する
    Set rs = New ADODB.Recordset

以上のコードは、各インスタンスを生成しているコードです。

23行目ではFileSystemObjectオブジェクトのインスタンス、26行目ではConnectionオブジェクトのインスタンス、Recordsetオブジェクトのインスタンスを生成しています。

FileSystemObjectオブジェクトのインスタンスは、Excelファイルの名称を取得するのに使います。

Connectionオブジェクトのインスタンスは、Excelファイルを取り込むためにマクロがそのExcelファイルに接続するのに使います。

Recordsetオブジェクトのインスタンスは、Excelファイルの表に対してSELECT文を実行したり、取得したデータやその件数を扱うのに使います。

以上の役割をそれぞれのインスタンスが担うので必ず各インスタンスの生成は忘れずに行います。

注目すべきコード②

次に見て頂きたいのは32行目から55行目です。

    'ブック内のシートの数分ループ
    For Each ws In Worksheets
    
        Select Case ws.Name
                
            Case "top", "work"
            
                'シート「top」「work」の場合は何もしない
            
            Case Else
            
                'シート「top」「work」以外の場合
            
                'メッセージを表示させないよう設定
                Application.DisplayAlerts = False
                
                'シートを削除する
                ws.Delete
                
                'メッセージを表示させない設定を解除
                Application.DisplayAlerts = True
        End Select
    Next ws

以上のコードは、同じ構造の表を持つ複数のExcelファイルをその表をマクロ側のExcelファイルに取り込む前に、「top」「work」以外のシートは削除しておくコードです。

マクロを実行するのに「top」「work」以外のシートは必要ないので削除しておきます。

「top」「work」以外のシートは削除するには、全てのシートを確認し、「top」「work」以外のシートが存在していれば一つ一つ削除する、という方法で対応しています。

32行目では、全てのシートを確認するためにExcelファイルのシートの数だけループさせるFor文を用意しています。

36行目のCaseでシート名が「top」か「work」を判定し、「top」か「work」の場合は何もせず、「top」か「work」でない場合は48行目でDeleteメソッドを実行して削除しています。

なお、45行目と51行目でApplication.DisplayAlertsプロパティのTrueとFalseを設定しているのは、シート削除時のメッセージボックスを表示する・しないを設定する処理です。

                'メッセージを表示させないよう設定
                Application.DisplayAlerts = False
                'メッセージを表示させない設定を解除
                Application.DisplayAlerts = True

Trueはメッセージを表示させ、Falseはメッセージを表示させないよう設定します。

Falseに設定せずにシートを削除しようとすると、以下のメッセージボックスが表示されます。

このメッセージボックスが表示されるとマクロの処理が止まってしまうので、シートを削除する前にFalseを設定しています。

シートを削除したら再度メッセージを表示させるよう元に戻すためにTrueを設定しておきます。

注目すべきコード③

次に見て頂きたいのは58行目です。

    'Excelファイルの数分ループさせる
    For Each excelFile In fso.GetFolder(filePath).Files

以上のコードは、取り込むExcelファイルの数分ループさせるFor文のコードです。

GetFolderメソッドに取り込むExcelファイルの格納先が入っている変数「filePath」を指定することで、FileプロパティからExcelファイル名を取得することができます。(フルパスで取得される)

For文が毎回繰り返されることでExcelファイル名を1つずつ取得することができます。

この取得したExcelファイルを元に後続の処理を行います。

注目すべきコード④

次に見て頂きたいのは67行目と68行目です。

        'データを貼り付ける先のシートを新規作成する
        Worksheets.Add(After:=Worksheets(Worksheets.Count)) _
                       .Name = pstDdSheetNM

以上のコードは、「注目すべきコード③」で取得したファイル名を使ってシートを作成しているコードの処理です。

Worksheets.Addメソッドでシートを作成し、そのシート名に変数「pstDdSheetNM」の値を使っています。

この変数「pstDdSheetNM」は61行目で取得しています。

        'データを貼り付ける先のシート名を取得する
        pstDdSheetNM = Replace(Split(excelFile, ".")(0), filePath & "\", "")

この変数「pstDdSheetNM」の値は、取り込むExcelファイルの「拡張子と『.』を取り除いたファイル名」から取得した文字列です。

例えば「C:¥work¥10_勉強¥10_VBA関連¥0196¥data¥」のフォルダにある「埼玉県.xlsx」というExcelファイルを取り込む場合は「埼玉県」が「pstDdSheetNM」に格納されます。

この「埼玉県」でシートが作成されました。

注目すべきコード⑤

次に見て頂きたいのは70行目と83行目です。

        With conn
        
            '接続情報の取得(自分自身のExcelファイルに接続する)
            .Provider = "Microsoft.ACE.OLEDB.12.0"
            .ConnectionString = "Data Source = " & excelFile & _
            ";Extended Properties =Excel 12.0;"
            
            'データソースへの接続を開く
            .Open
            
        End With
            
        'Recordsetを開く(表の件数と列数取得)
        rs.Open " [" & "data$" & "]", conn, adOpenStatic

以上のコードは、マクロが取り込むExcelファイルにADO接続し、Recordsetを開くコードです。

ADO接続するために必要なConnectionインスタンスに対してADO接続するために73行目から75行目で接続情報を設定します。

なお、74行目では自分自身のExcelファイルをフルパスで指定しています。

83行目では、Recordsetを開いています。

Recordsetを開くことで、取り込むExcelファイルの表のデータ行数や列数を取得することができます。

なお、Openメソッドの引数に指定した「data」の文字列は、取り込むExcelファイルの表があるシート名です。

「data」の文字列はシート名を指しているので、この「data」以外の文字列を指定してしまうとマクロが参照できずエラーになってしまいます。

なので間違えないように指定する必要があります。

注目すべきコード⑥

次に見て頂きたいのは90行目と93行目です。

        'excelファイルにある表の最後列の位置
        excelFlLstColPos = Split(Sheets("work").Cells(1, rs.Fields.Count).Address, "$")(1)
        
        'excelの表の範囲を取得する
        tblRangAry(cnt) = "[" & pstDdSheetNM & "$A1:" & excelFlLstColPos & rs.RecordCount + 1 & "]"

以上のコードは、excelファイルにある表の最後列の位置の取得し、その列と表の行数を使ってexcelの表の範囲を取得するコードです。

90行目では、rs.Fields.Countプロパティから、excelファイルにある表の最後列の位置を取得することができます。

93行目で、この最後列の位置と表の行数(rs.RecordCount)を使ってexcelの表の範囲を取得しています。

コードだと分かりづらいので、実際の値は次の通りです。

[埼玉県$A1:G6]は、「埼玉県.xlsx」の表のA1からG6のセルの範囲を指定していることを意味します。

なお、このセル範囲の外のセルに値が入っていたら、その値が入ったセルまでが範囲に入ってしまいます。

なのでExcelファイルを取り込む前に取り込みたい表の範囲以外のセルには値が入っていないように前準備しておく必要があるので注意です。

注目すべきコード⑦

次に見て頂きたいのは93行目と109行目です。

        With Worksheets(pstDdSheetNM)
            
            '表の範囲を取得する
            Set rng = .Range(.Cells(1, 1), .Cells(rs.RecordCount + 1, rs.Fields.Count))
        
            'データを貼り付ける先のシートにデータを貼り付ける
            rng.Formula = "=if(ISBLANK('" & filePath & "\[" & excelFile_np & "]work'!A1), """",'" & filePath & "\[" & excelFile_np & "]work'!A1)"
                    
            '取得先のExcelファイルを参照している計算式がセルに入力されているので、値そのものを再入力する
             rng.Copy: rng.PasteSpecial Paste:=xlPasteValues
             
             'コピー状態を解除する
             Application.CutCopyMode = False
        
        End With

以上のコードは、取り込み先のシートに取り込んだシートのデータを貼り付ける処理のコードです。

98行目で、閉じているExcelファイルの表の範囲を変数「rng」に格納しています。

この表の範囲に対して101行目で数式を出力しています。

以上のコードではどんな数式なのか分かりにくいので、実際の数式をお見せします。

コード

“=if(ISBLANK(‘C:\work\10_勉強\10_VBA関連\0196\data\[埼玉県.xlsx]work’!A1), “”,’C:\work\10_勉強\10_VBA関連\0196\data\[埼玉県.xlsx]work’!A1)”

これだと長すぎるので引数ごとに改行させると次の通りになります。

改行させたコード

=if(ISBLANK(‘C:\work\10_勉強\10_VBA関連\0196\data\[埼玉県.xlsx]work’!A1)
   , “”
   ,’C:\work\10_勉強\10_VBA関連\0196\data\[埼玉県.xlsx]work’!A1)

計算式の意味

  • フォルダ「C:¥work¥10_勉強¥10_VBA関連¥0196¥data」にあるexcelファイル「埼玉県.xlsx」のシート「data」のセルA1がブランク(正)かブランクでない(偽)かを判定します。
    ブランクの場合は第2引数を、ブランクでない場合は第3引数を返します。
返す値

  • フォルダ「C:¥work¥10_勉強¥10_VBA関連¥0185¥data」にあるexcelファイル「埼玉県.xlsx」のシート「data」のセルA1がブランクならブランクを返し、ブランクではない場合はフォルダ「C:¥work¥10_勉強¥10_VBA関連¥0185¥data」にあるexcelファイル「埼玉県.xlsx」のシート「data」のセルA1の値を返します。
補足
上記の計算式だとセルA1だけしかブランクかブランクでないかを判定していないように見えますが、98行目で表の範囲を取得したrngに対してこの計算式を設定しているので、この計算式はA1のセルだけでなく表のセル全てに適応されます。

以上のコードに出てくるISBLANK関数をなぜわざわざ使っているのかというと、空白のセルは必ずブランクにする必要があるからです。

なぜ空白のセルは必ずブランクにするのかというと、ブランクのセルが含まれる表をそのまま取り込んで取り込み先のセルに出力すると、そのブランクのセルが0で出力されてしまうからです。

取り込むexcelファイルの表

取り込み先のexcelファイルの表(取り込み後)※ISBLANK関数を使わなかった場合

以上のように値が0で出力されてしまうと、取り込んだ表のセルがブランクなのか初めから0が入力されているセルなのか判断が付きません。

そのためこの事象の回避策としてISBLANK関数を使い、取り込んだ表のブランクのセルは必ずブランクだと認識させるよう対応し、取り込み先の表のセルも同じくブランクとなるようにしておきます。

取り込むexcelファイルの表

取り込み先のexcelファイルの表(取り込み後)※ISBLANK関数を使わなかった場合

次に104行目のコードですが、このコードは閉じているExcelファイルから取り込んだマクロ側のセルに対して、値そのものを再入力している処理です。

なぜこの処理を行うのかというと、この処理を行わないと値を参照する閉じているExcelファイルが削除されたり移動された場合に値が参照できすに参照エラーになるからです。

以下は104行目のコードを実行する前のセルの数式は以下の画像の通りです。

以上の画像の赤枠で示した数式を見ると閉じているExcelファイルを参照しています。

このままだと、閉じているExcelファイルが削除されたり移動された場合に値が参照できすに参照エラーになってしまいます。

なので、値そのものを再入力してこの数式を値で上書きするようにすることで、閉じているExcelファイルが削除されたり移動された場合でも問題が起きることが無くなります。

注目すべきコード⑧

次に見て頂きたいのは111行目と115行目です。

        'recordsetを閉じる
        rs.Close

        'Connectionを切断する
        conn.Close

以上のコードは、recordsetとconnectionを閉じる処理と、recordsetのレコードを次のレコードに移動する処理です。

recordsetとconnectionは1つのexcelファイルに対して1回Openし、処理が終わったら必ずCloseさせる必要があります。(Openしている状態でもう一度Openを繰り返さない)

今回は同じrecordsetとconnection(変数exdRsと変数conn)を使いまわしているので、次のexcelファイルに対してrecordsetとconnectionをOpenするときはかならずCloseさせた状態でOpenさせないとエラーになります。(Openしているのに何でまたOpenするの?と怒られます)

なので、かならずこのClose処理を行います。

注目すべきコード⑨

次に見て頂きたいのは121行目と131行目です。

    With conn

        '接続情報の取得(自分自身のExcelファイルに接続する)
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source = " & ThisWorkbook.FullName & _
        ";Extended Properties =Excel 12.0;"

        'データソースへの接続を開く
        .Open

    End With

以上のコードは、マクロが自分自身のExcelファイルにADO接続するためのコードになります。

ADO接続するために必要なインスタンス(変数conn)に対してADO接続するために159行目から161行目で接続情報を設定します。

なお、125行目では自分自身のExcelファイルをフルパスで指定しています。

自分自身のExcelファイルのフルパスはThisWorkbook.FullNameプロパティから取得することができます。

注目すべきコード⑩

次に見て頂きたいのは134行目と157行目です。

    'SELECT文を用意する
    sqlStr = "Select"
    sqlStr = sqlStr & " *"
    sqlStr = sqlStr & " From"
    sqlStr = sqlStr & " ("
    sqlStr = sqlStr & " Select"
    sqlStr = sqlStr & " *"
    sqlStr = sqlStr & " From"
    sqlStr = sqlStr & " " & tblRangAry(0)
    
    '表をUNION ALLで結合する
    For cnt = 1 To UBound(tblRangAry)
    
        sqlStr = sqlStr & " UNION ALL"
        sqlStr = sqlStr & " Select"
        sqlStr = sqlStr & " *"
        sqlStr = sqlStr & " From"
        sqlStr = sqlStr & " " & tblRangAry(cnt)
        
    Next
    
    sqlStr = sqlStr & " )"
    sqlStr = sqlStr & " as info"
    sqlStr = sqlStr & " Where"
    sqlStr = sqlStr & " 市区町村名 like '%" & Worksheets("top").Range("lName").Value & "%'"

以上のコードは、取り込んだExcelファイルの表全てから条件に合致したデータを取得するSELECT文を用意しているコードです。

取り込んだ表はすべて同じ構造の表なので、UNION ALLを使って(146行目)表を結合させて条件に合致したデータを取得します。

結合元の表「tblRangAry(0)」に対して、144行目のFor文で繰り返し他の表を結合させます。

今回のサンプルでは市区町村名を検索条件にしており、その検索は部分一致であいまい検索するためにlikeを使っています。

なお、コードだけではSelect文が分かりにくいと思うので、実際に実行するSQLを以下にお見せします。

条件は市区町村名に「桐生市」を指定しています。

Select
    *
From
    (
        Select
            *
        From
            [千葉県$A1:G6]
        UNION ALL
        Select
            *
        From
            [埼玉県$A1:G6]
        UNION ALL
        Select
            *
        From
            [東京都$A1:G6]
        UNION ALL
        Select
            *
        From
            [栃木県$A1:G6]
        UNION ALL
        Select
            *
        From
            [神奈川県$A1:G6]
        UNION ALL
        Select
            *
        From
            [群馬県$A1:G6]
        UNION ALL
        Select
            *
        From
            [茨城県$A1:G6]
    ) as info
Where
    市区町村名 like '%桐生市%'

注目すべきコード⑪

次に見て頂きたいのは161行目です。

    'Recordsetを開く
    rs.Open sqlStr, conn, adOpenStatic

以上のコードは、recordsetのOpenメソッドに「注目すべきコード⑩」のSELECT文を引数に指定して実行してデータを取得するコードです。

recordsetのOpenメソッドが正常終了すると、SELECT文で取得したデータをExcelのシートに出力したりその件数を取得することができます。

注目すべきコード⑫

次に見て頂きたいのは162行目から197行目です。

    If CInt(rs.RecordCount) > 0 Then
    
        '検索データが0件よりも多い場合
    
        'データを出力するセルをクリアする
        Worksheets("work").Cells.Clear
    
        '表の列数分だけ処理をループする
        For cnt = 0 To rs.Fields.Count - 1
    
            '表の列名をセルに出力する
            Worksheets("work").Cells(1, 1 + cnt).Value = rs.Fields.Item(cnt).Name
    
        Next cnt
    
        '先ほど貼り付けた列名の下の行にデータを貼り付ける
        Worksheets("work").Cells(1, 1).Offset(1, 0).CopyFromRecordset rs
        
        'シート「top」を表示する
        Worksheets("work").Select
        
        'セルA1を選択する
        Worksheets("work").Range("A1").Select
    
        MsgBox "検索したデータが見つかりました。"
        
    Else
    
        '検索データが0件の場合
    
        'シート「top」を表示する
        Worksheets("top").Select
    
        MsgBox "検索したデータがありません。"
    
    End If

以上のコードは、「注目すべきコード⑪」で取得したデータからデータの件数を判定し、データがある場合はその取得したデータをシート「work」に出力する処理のコードです。

162行目では、取得したデータ件数が0件よりも多いか0件かを判定するIf文で、0件よりも多い場合は167行目でシート「work」をクリアします。

次に170行目から175行目では、表の列の数だけ繰り返しヘッダ(列名)をセルに出力しています。

173行目のFields.Item.Nameプロパティからヘッダ(列名)を取得することができます。

ヘッダ(列名)をセルに出力し終わったら178行目で、ヘッダ(列名)の1つ下のセル位置に結合させたデータをセルに貼り付けています。

取得したデータ件数が0件の場合(188行目)は195行目で検索したデータが無いことを知らせる旨のメッセージを表示させます。

動作確認

マクロ実行前

今回は「Excelファイルの例」のexcelファイルを使います。

テストとして市区町村名に「千代田区」を入力しました。

マクロ実行後

マクロ実行後は、市区町村名に「千代田区」が入力されているデータがシート「work」に出力されました。

最後に

本記事では、同じ構造の表を持つ複数のExcelファイルから条件に合致したデータを取得する方法についてご説明しました。

同じ構造の表なら、Excelファイルが複数あってもSQLのUNION ALLを使えばお手軽にデータを取得することができるので参考にしてみてくださいね。

Excelのスキル向上やExcelの基礎知識をしっかりと学びたいなら

Excelのスキルを習得したい、Excelの基礎知識をもっと理解したい、そう考えているなら「無期限サポート付きExcel講座【すごい改善】」がおすすめです。

Excelのスキルの基礎を身につけるなら【すごい改善】で無期限サポート付きがあるので、これで「Excelのスキルや基礎」を学ぶのにおすすめですよ。

→ 受講後、何度でも無期限でメールで質問できるアフターサポートがついているExcelマスター講座はこちら