エクセルVBAでSQLを使って高速にマッチングする方法

法人クライアント企業のスタッフさんから、以下のような内容の週報投稿がありました。

40000行と10000行のファイルを見比べて転記するマクロを実行すると次の日にならないと終了しないのが困っている

複数の表の間でのマッチングでは、データ量が増えると計算量が多くなります。データ量に応じて時間がかかるようになるのは、ある程度は仕方ないことです。

マッチングの方法はいくつかあります。以下、[1]→[4]の順でより高速になっていきます。

for next でマッチング
for each でマッチング
2.で、さらに .Find メソッドを使って見つける
SQLを発行する

これらに、 Exit For や Application.ScreenUpdating = False などの小技を組み合わせて効率化させていく感じです。

「for next でマッチング」は、基礎編で扱います。
「for each でマッチング」は、発展編1で。
「.Find メソッドを使ってのマッチング」は、発展編1での学びの応用です。「SQLを発行」は最強なのですが、事前知識と手間がかかります。

とはいえ、今日は ChatGPT などの生成AIもあるので...。
きちんと問えば、わりとなんとかなります。

「SQLを発行」について、サンプルコードを作ったのでこの場でシェアします。

概要としては、以下の流れになります。

[a] Access の機能をエクセルVBAから呼び出す
[b] CSVファイルやエクセルシートを Access DB として扱うための設定をする
[c] Access の機能が [b] で指定したデータベースに接続する
[d] SQL の SELECT 文を発行する
[e] SQL が返す結果を利用する
[f] Access の機能が [c] で行った接続を解除する

変数の宣言方法など細かなアレンジもあるのですが... Access が入ってるマシンであればおおむね動くかなという状態のサンプルをということで以下にしました。
以下、Windows11 であればたぶん動作するかと。

"data" という名前のワークシートがあり、セルA1から表がはじまっていることが条件です。出力先のシートは "result" です。

Sub FilterDataFromExcel()
    Dim conn As Object
    Dim rs As Object
    Dim strSQL As String
    Dim wb As Workbook
    Dim ws As Worksheet
' Set the workbook and worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("data")

' Excel data source

'[a] Access の機能をエクセルVBAから呼び出す
Set conn = CreateObject("ADODB.Connection")

'[b] CSVファイルやエクセルシートを Access DB として扱うための設定をする
conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & wb.FullName & ";Extended Properties='Excel 12.0 Xml;HDR=YES';"

'[c] Access の機能が [b] で指定したデータベースに接続する
conn.Open

'[d] SQL の SELECT 文を発行する
Set rs = CreateObject("ADODB.Recordset")
strSQL = "SELECT * FROM [" & ws.Name & "$] WHERE [番号] = 4;"
rs.Open strSQL, conn

'[e] SQL が返す結果を利用する(データ出力バージョン)
If Not rs.EOF Then
    rs.MoveFirst
    Dim i As Integer
    Do Until rs.EOF
        For i = 1 To rs.Fields.Count
            wb.Worksheets("result").Range("A" & i).Value = rs.Fields(i - 1).Name
            wb.Worksheets("result").Range("B" & i).Value = rs.Fields(i - 1).Value
        Next i
        rs.MoveNext
    Loop
End If

'[f] Access の機能が [c] で行った接続を解除する
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing

MsgBox "完了しました"

End Sub