【Excel VBA】2つの表を比較し、両方に存在する共通のデータ行を抽出する方法

2025年8月13日

「先月の顧客リスト」と「今月の顧客リスト」を比較して、両方のリストに名前がある顧客だけを抜き出したい、といった「2つのリストの共通項を探す」作業は、データ分析の現場で頻繁に発生します。

VBAを使えば、この照合と抽出のプロセスを自動化できます。この記事では、基本的なループ処理とCOUNTIF関数を組み合わせた方法と、Excelの強力な機能を活用した、より高速な「フィルターオプション（Advanced Filter）」を使う方法の2つを解説します。

方法1：For Eachループと COUNTIF関数を使う方法

一つ目のリストの各項目を順番に見ていき、その項目が二つ目のリストに存在するかをCOUNTIF関数でチェックしていく、という直感的で分かりやすい方法です。

完成したVBAコード

Sub ExtractMatches_WithLoop()

    ' 変数を宣言します
    Dim listA_Range As Range, listB_Range As Range
    Dim cell As Range
    Dim resultsSheet As Worksheet
    Dim outputRow As Long

    '--- 設定 ---
    ' 比較元となるリスト1（Sheet1のA列）
    Set listA_Range = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion
    ' 比較対象となるリスト2（Sheet2のA列）
    Set listB_Range = ThisWorkbook.Worksheets("Sheet2").Range("A1").CurrentRegion.Columns(1)
    
    ' 結果を出力するシートを準備
    Set resultsSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(2))
    resultsSheet.Name = "抽出結果"
    outputRow = 1
    '--- 設定ここまで ---
    
    Application.ScreenUpdating = False

    '--- リスト1の各セルをループ ---
    For Each cell In listA_Range.Columns(1).Cells
        ' リスト2に同じ値が存在するかをCOUNTIFでチェック
        If WorksheetFunction.CountIf(listB_Range, cell.Value) > 0 Then
            ' 存在した場合、元の行全体を結果シートにコピー
            cell.EntireRow.Copy resultsSheet.Cells(outputRow, 1)
            outputRow = outputRow + 1
        End If
    Next cell

    Application.ScreenUpdating = True
    
    MsgBox "共通データの抽出が完了しました。（ループ処理）"

End Sub

この方法はロジックが理解しやすいですが、比較元のリストの行数が数千、数万と多くなると、処理に時間がかかるというデメリットがあります。

方法2：フィルターオプション（Advanced Filter）を使う方法（推奨）

Excelに組み込まれている「フィルターオプション（Advanced Filter）」機能をVBAから呼び出す方法です。コードが非常に簡潔になり、処理も圧倒的に高速です。

準備

この方法では、フィルターの「検索条件範囲」として、見出し（ヘッダー）付きのリストが必要になります。比較対象となるリスト2（Sheet2）の1行目に見出し（リスト1の見出しと同じもの）がある状態を想定します。

完成したVBAコード

Sub ExtractMatches_WithAdvancedFilter()

    ' 変数を宣言します
    Dim listA_Range As Range
    Dim listB_CriteriaRange As Range
    Dim resultsSheet As Worksheet

    '--- 設定 ---
    ' 抽出元のデータ（見出しを含む）
    Set listA_Range = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion
    ' 抽出条件となるデータ（見出しを含む）
    Set listB_CriteriaRange = ThisWorkbook.Worksheets("Sheet2").Range("A1").CurrentRegion
    
    ' 結果を出力するシートを準備
    Set resultsSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(2))
    resultsSheet.Name = "抽出結果_高速版"
    '--- 設定ここまで ---

    '--- フィルターオプションを実行 ---
    listA_Range.AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=listB_CriteriaRange, _
        CopyToRange:=resultsSheet.Range("A1"), _
        Unique:=False

    MsgBox "共通データの抽出が完了しました。（フィルターオプション）"

End Sub

コードのポイント解説

listA_Range.AdvancedFilter ... これがフィルターオプションを実行する命令です。

Action:=xlFilterCopy: フィルター結果を別の場所にコピーするモードを指定します。
CriteriaRange:=listB_CriteriaRange: 検索条件となるセル範囲を指定します。ここでは、リスト2が見出しごと検索条件として機能します。
CopyToRange:=resultsSheet.Range("A1"): 抽出結果のコピー先となるセルを指定します。
Unique:=False: 重複するレコードを無視しない設定です。

この一行だけで、Excelが内部で最適化された高速な照合処理を行い、リストAの中から、リストBの条件に一致する行だけを、結果シートに一括でコピーしてくれます。

まとめ

方法	長所	短所
ループと`COUNTIF`	ロジックが直感的で分かりやすい。	データ量が多いと非常に遅い。
フィルターオプション	圧倒的に高速。コードが簡潔。	検索条件範囲に見出しが必要。

2つのリストを比較して共通のデータを抽出する場合、特別な理由がなければ、AdvancedFilter（フィルターオプション）を使う方法を強く推奨します。

VBAのループ処理で自前でロジックを組むよりも、Excelに組み込まれた専門機能を利用する方が、はるかにパフォーマンスが高く、コードもシンプルになります。

よかったらシェアしてね！