この記事では、同じ構造の表を持つ複数のExcelファイルから条件に合致したデータを取得する方法についてご説明します。
【動画】同じ構造の表を持つ複数のExcelファイルから条件に合致したデータを取得する実際の動き
本題に入る前に、まずは次の動画をご覧ください。
まず同じ構造の表を持つ複数のExcelファイルから、その表をマクロ側のExcelファイルに取り込みます。
その次にSELECT文を実行して取り込んだ表に対して合致するデータを抽出しています。
Excelファイルの例
マクロ側のExcelファイル
今回は次のExcelファイルを用意しました。
シート「top」のセルA2には「folderNM」という名前を付けており、このセルに同じ構造の表を持つ複数のExcelファイルの格納先を入力します。
セルA5には「lName」という名前を付けており、このセルに検索の条件を入力します。(今回のサンプルでは市区町村名を検索条件にしています)
シート「work」は検索した結果該当するデータが出力されるシートです。
出力結果は「動作確認」をご確認ください。
同じ構造の表を持つ複数のExcelファイル
今回はサンプル用に関東にある郵便局の一覧を用意しました。
以下のデータをマクロが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の表の範囲を取得しています。
コードだと分かりづらいので、実際の値は次の通りです。
なお、このセル範囲の外のセルに値が入っていたら、その値が入ったセルまでが範囲に入ってしまいます。
なので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の値を返します。
以上のコードに出てくるISBLANK関数をなぜわざわざ使っているのかというと、空白のセルは必ずブランクにする必要があるからです。
なぜ空白のセルは必ずブランクにするのかというと、ブランクのセルが含まれる表をそのまま取り込んで取り込み先のセルに出力すると、そのブランクのセルが0で出力されてしまうからです。
以上のように値が0で出力されてしまうと、取り込んだ表のセルがブランクなのか初めから0が入力されているセルなのか判断が付きません。
そのためこの事象の回避策として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マスター講座はこちら
