「会員リスト」と「イベント参加者リスト」を比較して、『会員だがイベントに参加しなかった人』を抽出したい、といった場面はありませんか?これは、2つのリストを比較し、一方にしか存在しない「差分」のデータを見つける作業です。
VBAを使えば、このような複雑な照合処理も自動化できます。この記事では、基本的なループ処理とCOUNTIF関数を組み合わせた方法と、VBA上級者が多用する高速な「Dictionaryオブジェクト」を使った方法の2つを解説します。
方法1:For Eachループ と COUNTIF関数 を使う方法
ロジックが直感的で分かりやすい方法です。「リストAの各項目が、リストBに存在しないか?」と「リストBの各項目が、リストAに存在しないか?」という2回のチェックをループ処理で行います。
完成したVBAコード
Sub ExtractDifferences_WithLoop()
' 変数を宣言します
Dim listA As Range, listB As Range
Dim cell As Range
Dim resultsSheet As Worksheet
Dim outputRow As Long
'--- 設定 ---
Set listA = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion
Set listB = ThisWorkbook.Worksheets("Sheet2").Range("A1").CurrentRegion
' 結果を出力するシートを準備
Set resultsSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(2))
resultsSheet.Name = "差分データ"
resultsSheet.Range("A1").Value = "リストAのみに存在するデータ"
outputRow = 2
'--- 設定ここまで ---
Application.ScreenUpdating = False
'--- 1. リストAにしか存在しないデータを検索 ---
For Each cell In listA.Columns(1).Cells
' リストBに同じ値が存在しない(COUNTIFの結果が0)場合
If WorksheetFunction.CountIf(listB.Columns(1), cell.Value) = 0 Then
cell.EntireRow.Copy resultsSheet.Cells(outputRow, 1)
outputRow = outputRow + 1
End If
Next cell
'--- 2. リストBにしか存在しないデータを検索 ---
resultsSheet.Cells(outputRow, 1).Value = "リストBのみに存在するデータ"
outputRow = outputRow + 1
For Each cell In listB.Columns(1).Cells
' リストAに同じ値が存在しない場合
If WorksheetFunction.CountIf(listA.Columns(1), cell.Value) = 0 Then
cell.EntireRow.Copy resultsSheet.Cells(outputRow, 1)
outputRow = outputRow + 1
End If
Next cell
resultsSheet.UsedRange.Columns.AutoFit
Application.ScreenUpdating = True
MsgBox "差分データの抽出が完了しました。(ループ処理)"
End Sub
この方法は理解しやすいですが、2つのリストを総当たりでチェックするため、データが数千行を超えるとパフォーマンスが著しく低下する可能性があります。
方法2:Dictionaryオブジェクトを使う方法(推奨)
Dictionaryオブジェクトは、VBAで高速な連想配列(キーと値のペア)を扱うための機能です。これを利用すると、大量のデータでも極めて高速に差分を抽出できます。
【重要】事前準備:参照設定
この方法では、VBAエディタでツール > 参照設定を開き、**「Microsoft Scripting Runtime」**にチェックを入れる必要があります。
完成したVBAコード
'参照設定: Microsoft Scripting Runtime
Sub ExtractDifferences_WithDict()
Dim listA As Range, listB As Range
Dim resultsSheet As Worksheet
Dim dict As New Scripting.Dictionary ' Dictionaryオブジェクト
Dim cell As Range
Dim key As Variant
Dim outputRow As Long
'--- 設定 ---
Set listA = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion
Set listB = ThisWorkbook.Worksheets("Sheet2").Range("A1").CurrentRegion
Set resultsSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(2))
resultsSheet.Name = "差分データ_高速版"
'--- 設定ここまで ---
Application.ScreenUpdating = False
' 1. リストAの全項目をDictionaryに登録
For Each cell In listA.Columns(1).Cells
If Not dict.Exists(cell.Value) Then
dict.Add cell.Value, cell.Row
End If
Next cell
' 2. リストBの項目をチェック。共通ならDictionaryから削除
For Each cell In listB.Columns(1).Cells
If dict.Exists(cell.Value) Then
' 共通の項目はDictionaryから削除
dict.Remove cell.Value
Else
' リストBにしか存在しない項目は、その場で結果シートにコピー
If outputRow = 0 Then
resultsSheet.Range("A1").Value = "リストBのみに存在するデータ"
outputRow = 2
End If
cell.EntireRow.Copy resultsSheet.Cells(outputRow, 1)
outputRow = outputRow + 1
End If
Next cell
' 3. Dictionaryに残った項目(リストAのみのデータ)をコピー
If dict.Count > 0 Then
resultsSheet.Cells(outputRow, 1).Value = "リストAのみに存在するデータ"
outputRow = outputRow + 1
For Each key In dict.Keys
listA.Rows(dict(key)).EntireRow.Copy resultsSheet.Cells(outputRow, 1)
outputRow = outputRow + 1
Next key
End If
resultsSheet.UsedRange.Columns.AutoFit
Application.ScreenUpdating = True
MsgBox "差分データの抽出が完了しました。(Dictionary)"
End Sub
このコードは、Dictionaryの高速な検索能力を利用しているため、データが何万行あっても、ほぼ一瞬で処理が完了します。
まとめ
| 方法 | 長所 | 短所 |
ループとCOUNTIF | ロジックが直感的で分かりやすい。 | データ量が多いと非常に遅い。 |
| Dictionaryオブジェクト | 圧倒的に高速。 | コードがやや複雑になり、事前準備(参照設定)が必要。 |
2つのリストの差分を抽出する場合、データ量が多い、またはパフォーマンスが求められる場面では、Dictionaryオブジェクトを使う方法を強く推奨します。
最初は少し難しく感じるかもしれませんが、このテクニックをマスターすると、VBAで扱えるデータ処理の幅が大きく広がります。
副業から独立まで「稼げる」Webスキルを習得する(PR)
ここまで読んでいただきありがとうございます。 最後に宣伝をさせてください。
「副業を始めたいが、何から手をつければいいかわからない」「独学でスキルはついたが、収益化できていない」という悩みを持つ方には、マンツーマン指導のWebスクール**「メイカラ」**が適しています。
このスクールは、単に技術を教えるだけでなく、**「副業として具体的にどう稼ぐか」**という実務直結のノウハウ提供に特化している点が特徴です。
講師陣は、実際に「副業Webライターから1年で独立して月収100万円」を達成したプロや、現役で利益を出し続けているブロガーなど、確かな実績を持つプレイヤーのみで構成されています。そのため、机上の空論ではない、現場で通用する戦術を学ぶことができます。
副業に特化した強み
- 最短ルートの提示: 未経験からでも実績を出せるよう、マンツーマンで指導。
- AI活用の習得: 副業の時間対効果を最大化するための、正しいAI活用スキルも網羅。
- 案件獲得のチャンス: 運営がWebマーケティング会社であるため、実力次第で社内案件の紹介など、仕事に直結する可能性があります。
受講者の多くは、「在宅でできる仕事を探している」「副業を頑張りたい」という20代・30代・40代が中心です。
受講前には、講師による無料説明が行われます。無理な勧誘はなく、自分に合った副業スタイルやプランを相談できるため、まずは話を聞いてみることから始めてみてはいかがでしょうか。
