データ範囲の一致を確認する方法の続きです。
２つのセル範囲が一致するかを確認するには
前回の記事はこちらです。
フィルターオプションを使う
「フィルターオプション」を使って、行ごとの比較による絞り込みで差異の有無を確認してみたいと思います。
フィルターオプションとか言われてもピンとこないかもしれませんが、「データ」タブの「並べ替えとフィルター」にある「詳細設定」で開くダイアログのことです。 オートフィルターではできない複雑な絞り込み条件でのデータ抽出が可能です。
本記事ではちょっと特殊な使い方ですが、抽出条件に「数式」が使えることに着目し、これを応用します。
【手順例】
- 2つのデータのセル範囲を、コピー＆ペーストなどで横並びに配置します
- 余白のセルに以下のような抽出条件の数式を用意します
=OR(左表の一行目のセル範囲<>右表の一行目のセル範囲)
あるいは
=NOT(AND(EXACT(左表の一行目のセル範囲, 右表の一行目のセル範囲)))- 条件式のひとつ上のセルを空けておきます
- 両データ範囲をまとめて選択状態にします
- 見出しを含めます
- 「フィルターオプション」ダイアログを開きます。
- 「データ」タブ ⇒「並べ替えとフィルター」セクション ⇒「詳細設定」ボタン
- 抽出対象を設定します
- 「抽出先」⇒ 「選択範囲内」
- 「リスト範囲」⇒ 両データ範囲（入力済み）
- 「検索条件範囲」⇒ 数式セルとそのひとつ上のセルのセル範囲
- 「重複を削除」⇒ オフ
- 「OK」ボタンを押します
- 抽出結果を確認します
もし左右の表が完全に一致していれば、抽出結果が空になることで確認できます。
もし一致しなければ、差異のある行が絞り込まれるはずです。
絞り込みを解除するには、「並べ替えとフィルター」で「詳細設定」の上にある「クリア」ボタンを押してください。
この方法は、２つのデータを同一シート上に横並びさせる必要があるのが難点ですが、 大きな表でも判定と同時に差異のあったセルを確認できるのがいいところです。
さて、解説も必要でしょう。
フィルターオプションでは通常、抽出条件として列見出しに対して比較する値を表形式で指定するものなのですが、 この見出しを省略（空セルあるいは見出し以外の文字列に）すると、任意の数式を条件にすることができるという仕様になっています。
このとき数式の結果が TRUE となる行のみが抽出されます。
また、数式内ではセル参照や見出し名が使えるので、1行目に対して行内のセルを参照する評価式を用意すれば、残りの全行にも適用されて、結果が TRUE となる行のみが絞り込まれます。
たとえば、次のような条件式の数式を指定した場合、
=B6<>C6
フィルターオプションは、=B7<>C7、=B8<>C8、と各行を評価し、TRUEとなる（AとBが一致しない）行だけを絞り込みます。
そこで、横並びにした２表の、全ての列の組についての評価式を用意すれば、差異のある行のみを抽出することができるはずです。
ただ、やってみると、各列の不等号式を並べて記述するのはとても煩雑で面倒なことです。
=OR(B7<>F7, C7<>G7, D7<>H7)
ここでも配列数式が役に立ちます（Microsoft 365 版のみ）。
=OR(B7:D7<>F7:H7)
とスッキリした数式で表現できます。
ただしこのテクニックが使えるのは、動的配列数式をサポートしてる Micorsoft 356 版 Excel のみです。
残念ながら、古い Excel のレガシー配列数式(Ctrl+Shift+Enter)では動きません。
Excel 2013 ユーザとしてはちょっと悔しい感じです。
もしどうしても古い Excel でもセル範囲比較をしたいというなら、以下のような SUMPRODUCT 関数を使った条件式を代わりに使うと同様の結果が得られるはずです。 あまりお勧めはしませんが。
=SUMPRODUCT((B7:D7=F17:H7)-1) あるいは =SUMPRODUCT(EXACT(B7:D7,F17:H7)-1)
データを照合するクエリ
上級者向けのオマケです。
データが巨大になると、手作業ではやっていられませんね。
そこで Power Query で2つの表を照合するクエリを作成してみました。 コピー＆ペーストで利用できます。
用意したクエリは以下の2つです。
- 「完全一致判定」クエリ
- 「相違行抽出」クエリ
どちらも新規ブックに、テーブル化した2つの表を用意し、このクエリを実行するだけで結果を得られます。
「完全一致判定」クエリ
「完全一致判定」クエリは２つのテーブルの全てのセルの内容が一致しているかどうかを判定するものです
２つのテーブルに対してこのクエリを実行すると、全てのセルの内容が一致する場合は「一致」、１箇所でも相違があれば「相違」を出力します。
let
tables = Excel.CurrentWorkbook(),
couple = Table.FirstN(tables, 2)[Content],
result = List.Distinct(couple)
in
#table(1, {{
if List.Count(couple) < 2 then "比較するテーブルを２つ用意してください"
else if List.Count(result) = 1 then "一致"
else "相違"
}})
比較には列見出しも含まれますが、列の並びが異なっていてもかまいません。
２つの表の行数が異なるが場合でも「相違」となります。
テキストの比較では英字の大文字と小文字が区別されます。
「相違行抽出」クエリ
「相違行抽出」クエリは、２つのテーブルで相違のある行を抽出するものです。
２つのテーブルの同じ行の内容を照合し、もし一カ所でも相違があれば、両者の行を横並びにして出力します。
let
tables = Excel.CurrentWorkbook(),
couple = Table.FirstN(tables, 2)[Content],
t01 = List.Zip({couple, {"l", "r"}}),
t02 = List.Transform(t01, each Table.PrefixColumns(_{0}, _{1})),
t03 = List.Transform(t02, Table.ColumnNames),
見出し = List.Combine(t03),
r01 = List.Transform(couple, Table.ToRows),
r02 = List.Zip(r01),
r03 = List.Select(r02, List.IsDistinct),
相違行 = List.Transform(r03, List.Combine),
result = Table.FromRows(相違行, 見出し)
in
result
2つの表の列見出しは比較されませんが、列数と並びが一致している必要があります。
２つの表の行数が異なる場合はエラーとなり、どこが異なるかはわかりません。
テキストの比較では英字の大文字と小文字が区別されます。
【使い方】
- 新規ワークブックを開きます
- 比較したい２つの表をシートにコピーして、それぞれ Excel テーブルに変換します（
Ctrl+T）- 各テーブルは別々のシートでかまいません。
- 「空のクエリ」を開き、「詳細エディタ」で上記クエリの一つをコピー＆ペーストします
- 「完了」ボタンを押します
- この時点でクエリエディタに結果が表示されています
- 「閉じて読み込む」ボタンを押します
- 新規ワークシートが追加され、クエリの結果が出力されます
本クエリはブック内の最初の2つの Excel テーブルを照合対象とします。
クエリは「更新」で再実行できますが、その前に、クエリ結果のテーブルが対象にならないよう、クエリ結果のシートを一番最後に移動してください。
データを照合するマクロ
いろいろな方法を試してみましたが、イマイチどれもしっくりきません。 比較可能なデータや配置に制約があったり、前準備や数式入力が必要だったりしていろいろ気を使います。
もっと何も考えずにパッと確認したいのです、パッと。
そこで、セル範囲を選択するだけでデータを比較して照合結果を返すマクロを作成してみました。 コピー＆ペーストで使えます。
マクロは２つ用意しました。 ⇒ 一つにまとめました。
- 「セル範囲比較_相違セル色付け」マクロ
「セル範囲比較_相違セル色付け」マクロは、選択された２つのセル範囲で相違のあったセルを選択状態にし、黄色で色付けをします。 色付けの対象となるのは、比較元（始めに選択した方）のセル範囲です。
色付けを省略してセル選択のみにもできるので、後から好きなスタイルを設定することも可能です。 そのほうが「元に戻す（Undo）」もできるので扱いやすいかもしれません。
また別々のシートやワークブックにあるデータ範囲間でも比較することが可能です。
Option Explicit Sub セル範囲比較_相違セル色付け() Const MACRO = "セル範囲比較_相違セル色付け" Const FILLCOLOR = 6 ' 黄色 If TypeName(Selection) <> "Range" Then Beep: Exit Sub Dim rngs() As Range rngs = inputMultiRanges(MACRO, Selection, "1. 比較元のセル範囲", "2. 比較先のセル範囲") If rngs(1) Is Nothing Then Exit Sub Set rngs(0) = rangeCutout(rngs(0)) Set rngs(1) = rangeCutout(rngs(1)) If rngs(0) Is Nothing Or rngs(1) Is Nothing Then MsgBox "データのある領域を選択してください", vbExclamation, Title:=MACRO Exit Sub ElseIf Not rangeEqualSize(rngs(0), rngs(1)) Then MsgBox "比較元と比較先の行列数をそろえてください", vbExclamation, Title:=MACRO Exit Sub End If On Error GoTo final Dim diff As Range Set diff = rangeCompare(rngs(0), rngs(1)) If diff Is Nothing Then MsgBox "完全に一致しました！", vbOKOnly, MACRO Else Application.Goto diff diff.Select If vbYes = MsgBox(diff.Count & "件相違が見つかり、選択状態にしました" & vbCrLf & "相違セルに色をつけますか", _ vbYesNo + vbQuestion, MACRO) Then diff.Interior.ColorIndex = FILLCOLOR End If End If final: If Err.Number <> 0 Then MsgBox Err.Description, vbCritical, Err.Source End Sub Function rangeCompare(rng1 As Range, rng2 As Range) As Range If rangeEqualSize(rng1, rng2) = False Then Err.Raise 9999, "rangeCompare", "Range Err: サイズ違い" Dim bools As Variant bools = rng1.Parent.Evaluate("INDEX(EXACT(" _ & rng1.Resize(rng1.Rows.Count + 1).Address(external:=True) & "," _ & rng2.Resize(rng2.Rows.Count + 1).Address(external:=True) & "),)") ' Microsoft365ならINDEXを外せてその分速くなるはず If IsError(bools) Then Err.Raise 9999, "rangeCompare", "Eval Err: " & CStr(bools) Dim r As Long Dim c As Long For r = 1 To rng1.Rows.Count For c = 1 To rng1.Columns.Count If bools(r, c) = False Then If rangeCompare Is Nothing Then Set rangeCompare = rng1(r, c) Else Set rangeCompare = Union(rangeCompare, rng1(r, c)) End If End If Next Next End Function Function rangeEqualSize(l As Range, r As Range) As Boolean rangeEqualSize = (l.Rows.Count = r.Rows.Count) And (l.Columns.Count = r.Columns.Count) End Function Private Function rangeCutout(rng As Range) As Range Set rangeCutout = rng Dim ws As Worksheet Set ws = rng.Worksheet If rng.Rows.Count >= Rows.Count Then Set rangeCutout = Intersect(rangeCutout, ws.Range("a1", ws.UsedRange.EntireRow)) End If If rng.Columns.Count >= Columns.Count Then Set rangeCutout = Intersect(rangeCutout, ws.Range("a1", ws.UsedRange.EntireColumn)) End If End Function Private Function inputMultiRanges(Title As String, rngDefault As Range, ParamArray prompts() As Variant) As Range() Debug.Assert UBound(prompts) >= 0 Dim rngs() As Range ReDim rngs(UBound(prompts)) Dim i As Long For i = 0 To UBound(prompts) If 1 < rngDefault.Areas.Count And rngDefault.Areas.Count > i Then Set rngs(i) = rngDefault.Areas(i + 1) Else Set rngs(i) = CRange(Application.InputBox(prompts(i), Title, rngDefault.Address, Type:=8)) If rngs(i) Is Nothing Then Exit For Set rngs(i) = rngs(i).Areas(1) DoEvents End If Next DoEvents inputMultiRanges = rngs End Function Private Function CRange(val As Variant) As Range Set CRange = IIf(TypeName(val) = "Range", val, Nothing) End Function
【使い方】
- 新規標準モジュールに上記 VBA プログラムをコピー＆ペーストします
- データとは別のブックにマクロを用意することをお勧めします
- 上記マクロのどちらかを実行します
- セル範囲選択のダイアログが２回（比較元と比較先）表示されるので、データ領域のセル範囲を選択し、「OK」ボタンを押します
- 「キャンセル」ボタンならマクロを中断します
- すべてのセルで値が一致していた場合、その旨のダイアログが表示されます。
- １か所でも相違があった場合、色付けをするかどうかを尋ねるダイアログが表示されます
- 選択したセル範囲（比較元）の相違セルが選択状態になります。
- 「はい」を押すと、相違セルが黄色（#FFFF00）で色付けされます。
同一シート上のデータなら、マクロを実行する前にあらかじめ２つのデータ領域を選択指定しておくことで、ダイアログによる選択を省略できます。
セル範囲選択ダイアログでは他のシートやワークブックのデータ領域を選択することもできます。
データ領域の行数が多い時には、列ごと範囲選択すると楽に選択できます。
「セル範囲比較_相違セル色付け」マクロは相違セルを色付けしますが、一致セルの方では色クリアなどの変更を行うことはありません。
英字の大文字と小文字は区別されます。
【注意】 マクロの実行結果は「元に戻す（Undo）」することができません。 すでに色付けされいたセルの色は上書きされて戻せませんので細心の注意を払って実行してください。
【免責】 本ブロクの筆者はブログに掲載されたマクロや操作の実行によって発生したいかなる損失・損害についても責任を負いかねますのであらかじめご了承ください。 ** [2021/02/04 VBAソース修正] 一部使い勝手の改善と不具合の修正をしました。不具合を見つけたら教えてください。
まとめ
Excel の標準機能を駆使して2つのセル範囲を比較する技をあれこれ考えてみたのですが、いかがでしたでしょうか。
ちょっと意地になりすぎて Excel の普段使わない マニアックな機能にまで踏み込みすぎた感がなくもないですが、 やってやれないことはないという結論です。
どれの技もクセがあって一長一短ですが、みなさんの日常の作業等でうまくハマりそうなものがあれば試してみてください。 個人的には「アクティブ行との相違（Ctrl+￥）」というのが気に入っていて、日常業務でも重宝しています。
またもしもっといい方法があったらぜひ教えてください。
本記事の操作やマクロの内容は Excel 2013 と Microsoft 365 版の Excel （バージョン2012）で動作確認しました。
