Rangeオブジェクトの論理演算（差集合と排他的論理和）
複数のRangeオブジェクトの重なっている範囲や、結合した範囲等々、
Rangeオブジェクトを集合として、その集合演算の結果のRangeオブジェクトが必要になってくる場合がVBAでは良くでてきます。
和集合：Unionメソッド
積集合：Intersectメソッド
この二つがありますが、
補集合、差集合、排他的論理和に該当するものはサポートされていません。
頻繁に必要になるものではないのですし、通常は何らかの別手段で実現しているものになります。
今回は、これら補集合、差集合、排他的論理和をVBAで自作してみました。
集合について
まずは集合の基礎として、
和集合、積集合、補集合、差集合、排他的論理和
これらをベン図で確認しておきましょう。
和集合、積集合、補集合、差集合、排他的論理和
これらをベン図で確認しておきましょう。
和集合・・・VBAの論理演算子は Or
積集合・・・VBAの論理演算子は And
補集合・・・VBAの論理演算子は Not
差集合・・・VBAの論理演算子はありません
排他的論理和・・・VBAの論理演算子は Xor
Rangeオブジェクトの論理演算のVBAについて
VBAでサポートされていない、
補集合、差集合、排他的論理和
これらを自作します。
処理速度を全く考慮しないのであれば、
For Eachでセルを一つずつ判定しつつUnionしていけばVBAは完成します。
補集合、差集合、排他的論理和
これらを自作します。
For Eachでセルを一つずつ判定しつつUnionしていけばVBAは完成します。
Rangeの排他的論理和：セルを一つずつ処理
'Rangeの排他的論理和：セルを一つずつ処理
Function ExclusiveCells(aRng1 As Range, aRng2 As Range) As Range
Dim rng As Range, andRng As Range
Set andRng = Intersect(aRng1, aRng2)
If andRng Is Nothing Then
Set ExclusiveCells = Union(aRng1, aRng2)
Exit Function
End If
For Each rng In Union(aRng1, aRng2)
If Intersect(andRng, rng) Is Nothing Then
If ExclusiveCells Is Nothing Then
Set ExclusiveCells = rng
Else
Set ExclusiveCells = Union(ExclusiveCells, rng)
End If
End If
Next
End Function
このVBAなら割と簡単に作成できるでしょう。
和集合の一つずつのセルについて、積集合に含まれていないものを集めているだけです。
多くの場合はこれで用が足りてしまうかもしれません。
このようなVBAの問題点は、引数に列全体を指定した場合です。
現在のExcelは100万行あります。
それでも1列くらいなら上記VBAでもちょっと待てば処理が終了します。
しかし複数の列全体、例えば"E:J"くらいを上記VBAで処理したら・・・
時間がかかりすぎてしまって、実用に耐えられないことが分かるはずです。
そこで、これをセル1つずつ判定せずにAreas単位（つまり矩形単位）で処理するVBAを作ろうという事です。
このとき、最も面倒、かつ、これさえできれば他は何とかなるというのが補集合です。
例えば、（差集合は-で記述しています）
和集合の一つずつのセルについて、積集合に含まれていないものを集めているだけです。
多くの場合はこれで用が足りてしまうかもしれません。
現在のExcelは100万行あります。
それでも1列くらいなら上記VBAでもちょっと待てば処理が終了します。
しかし複数の列全体、例えば"E:J"くらいを上記VBAで処理したら・・・
時間がかかりすぎてしまって、実用に耐えられないことが分かるはずです。
このとき、最も面倒、かつ、これさえできれば他は何とかなるというのが補集合です。
例えば、（差集合は-で記述しています）
A - B
A - Bは、
A And Not(B)
このように定義できます。
A And Not(B)
このように定義できます。
そして、AndはIntersectがあるので、Notさえあれば差集合は完成します。
そして、差集合が出来れば排他的論理和も簡単に作成できます。
そして、差集合が出来れば排他的論理和も簡単に作成できます。
A Xor B
A Xor Bは、
(A - B) Or (B - A)
A - B
B - A
(A - B) Or (B - A)
さらに、このような論理式でも表せます。
(A Or B) And Not(A And B)
A And B
Not(A And B)
A Or B
(A Or B) And Not(A And B)
(A - B) Or (B - A)
A - B
(A Or B) And Not(A And B)
RangeオブジェクトにはAreasがある
注意しなければならないことがあります。
Rangeオブジェクトは矩形の1領域とは限りません。
RangeオブジェクトにはAreasが存在し、複数の領域（セル範囲）が含まれています。
Range("A2:D3,B4:E4")
これは1つのRangeオブジェクトの中に、
Range("A2:D3")とRange("B4:E4")これが一緒になって入っています。
つまりこれは、
Range("A2:D3,B4:E4") = Union(Range("A2:D3"), Range("B4:E4"))
（この=は代入ではなく等しいという意味です。）
この場合、Rangeオブジェクトには2つのAreasがある状態という事です。
したがって、以降のVBAを見るときには、
・矩形の1領域のRangeに対するプロシージャー
・複数のAreasを含んだRangeに対するプロシージャー
この2種類があることに注意してください。
Rangeオブジェクトは矩形の1領域とは限りません。
RangeオブジェクトにはAreasが存在し、複数の領域（セル範囲）が含まれています。
Range("A2:D3,B4:E4")
これは1つのRangeオブジェクトの中に、
Range("A2:D3")とRange("B4:E4")これが一緒になって入っています。
つまりこれは、
Range("A2:D3,B4:E4") = Union(Range("A2:D3"), Range("B4:E4"))
（この=は代入ではなく等しいという意味です。）
したがって、以降のVBAを見るときには、
・矩形の1領域のRangeに対するプロシージャー
・複数のAreasを含んだRangeに対するプロシージャー
この2種類があることに注意してください。
和集合：Unionメソッド
Rangeオブジェクトの和集合はApplicationのUnionメソッドを使用します。
Unionメソッドの詳細については以下をご覧ください。
第103回.UnionメソッドとAreasプロパティ｜VBA入門
Unionメソッドでは、引数のRangeオブジェクトの1つでもNothingがあるとエラーとなります。
したがって、引数のNothing判定が必要になりますが、これはVBA記述する上でとても面倒です。
そこで、Nothing判定を組み込んだ関数Functionを作成しておきます。
Unionメソッドの詳細については以下をご覧ください。
・Unionメソッド ・Areasプロパティ ・Unionメソッドで連結した結果のRangeオブジェクトの状態について ・Unionメソッドの使用例 ・Unionメソッドの実践例
Unionメソッドでは、引数のRangeオブジェクトの1つでもNothingがあるとエラーとなります。
したがって、引数のNothing判定が必要になりますが、これはVBA記述する上でとても面倒です。
そこで、Nothing判定を組み込んだ関数Functionを作成しておきます。
'Rangeの和集合：Nothingを考慮
Function UnionRange(aRng1 As Range, aRng2 As Range) As Range
If aRng1 Is Nothing Then
If aRng2 Is Nothing Then
Set UnionRange = Nothing
Else
Set UnionRange = aRng2
End If
Else
If aRng2 Is Nothing Then
Set UnionRange = aRng1
Else
Set UnionRange = Union(aRng1, aRng2)
End If
End If
End Function
積集合：Intersectメソッド
Rangeオブジェクトの積集合はApplicationのIntersectメソッドを使用します。
Intersectメソッドの詳細については以下をご覧ください。
第102回.Intersectメソッド｜VBA入門
Intersectメソッドでは、引数のRangeオブジェクトの1つでもNothingがあるとエラーとなります。
したがって、引数のNothing判定が必要になりますが、これはVBA記述する上でとても面倒です。
そこで、Nothing判定を組み込んだ関数Functionを作成しておきます。
Intersectメソッドの詳細については以下をご覧ください。
・Intersectメソッド ・Intersectの使用例 ・Intersectメソッドの最後に
Intersectメソッドでは、引数のRangeオブジェクトの1つでもNothingがあるとエラーとなります。
したがって、引数のNothing判定が必要になりますが、これはVBA記述する上でとても面倒です。
そこで、Nothing判定を組み込んだ関数Functionを作成しておきます。
Rangeの積集合：Nothingを考慮
'Rangeの積集合：Nothingを考慮
Function IntersectRange(aRng1 As Range, aRng2 As Range) As Range
If aRng1 Is Nothing Then
If aRng2 Is Nothing Then
Set IntersectRange = Nothing
Else
Set IntersectRange = aRng2
End If
Else
If aRng2 Is Nothing Then
Set IntersectRange = aRng1
Else
Set IntersectRange = Intersect(aRng1, aRng2)
End If
End If
End Function
補集合
Rangeの補集合：単一Area限定
'Rangeの補集合：単一Area限定
Function NotRange(aRng1 As Range) As Range
Dim ws As Worksheet
Set ws = aRng1.Worksheet
Dim i As Long
Dim rng As Range
'範囲の上・・・①
i = aRng1.Item(1).Row - 1
If i > 0 Then
Set NotRange = UnionRange(NotRange, ws.Range(ws.Rows(1), ws.Rows(i)))
End If
'範囲の下・・・②
i = aRng1.Item(aRng1.Rows.Count, aRng1.Columns.Count).Row + 1
If i < Rows.Count Then
Set NotRange = UnionRange(NotRange, ws.Range(ws.Rows(i), ws.Rows(ws.Rows.Count)))
End If
'範囲の左・・・③
i = aRng1.Item(1).Column - 1
If i > 0 Then
Set rng = Intersect(ws.Range(ws.Columns(1), ws.Columns(i)), aRng1.EntireRow)
Set NotRange = UnionRange(NotRange, rng)
End If
'範囲の右・・・④
i = aRng1.Item(aRng1.Rows.Count, aRng1.Columns.Count).Column + 1
If i < Columns.Count Then
Set rng = Intersect(ws.Range(ws.Columns(i), ws.Columns(ws.Columns.Count)), aRng1.EntireRow)
Set NotRange = UnionRange(NotRange, rng)
End If
End Function
Rangeオブジェクトの論理演算のVBAを作成する上で、ここが一番面倒な所になるでしょう。
考え方としては、矩形の補集合なので、四角形の外側を求めれば良いという事です。
Range("B3:C5")の補集合のRangeは、
上記VBAでは、この4つの領域を算出しUnionして結果を求めています。
Rangeの補集合：Areas対応
'Rangeの補集合：Areas対応
Function NotAreas(aRng1 As Range) As Range
Dim rng1 As Range
Set NotAreas = Nothing
For Each rng1 In aRng1.Areas
Set NotAreas = IntersectRange(NotAreas, NotRange(rng1))
Next
End Function
単一Areaの補集合があれば、これらの積集合を求めれば複数領域の補集合は作成できます。
差集合
Rangeの差集合：単一Area限定
'Rangeの差集合：単一Area限定
Function ExceptRange(aRng1 As Range, aRng2 As Range) As Range
Set ExceptRange = Intersect(aRng1, NotRange(aRng2))
End Function
Rangeの差集合：Areas対応
'Rangeの差集合：Areas対応
Function ExceptAreas(aRng1 As Range, aRng2 As Range) As Range
Dim eRange As Range
Dim rng1 As Range, rng2 As Range
Set ExceptAreas = Nothing
For Each rng1 In aRng1.Areas
Set eRange = Nothing
For Each rng2 In aRng2.Areas
Set eRange = IntersectRange(eRange, ExceptRange(rng1, rng2))
Next
Set ExceptAreas = UnionRange(ExceptAreas, eRange)
Next
End Function
.Areasに対してFor Eachしています。
単にRangeオブジェクトに対してFor Eachにしてしまうと、セル1つずつの処理になってしまいます。
差集合なので、全く同範囲のRangeを2つ指定した場合はNothingが戻されます。
排他的論理和
Rangeの排他的論理和：単一Area限定
'Rangeの排他的論理和：単一Area限定
Function ExclusiveRange(aRng1 As Range, aRng2 As Range) As Range
'(A - B) Or (B - A)
Set ExclusiveRange = Intersect(Union(aRng1, aRng2), NotRange(Intersect(aRng1, aRng2)))
'(A Or B) And Not(A And B)
'Set ExclusiveRange = Union(ExceptRange(aRng1, aRng2), ExceptRange(aRng2,
aRng1))
End Function
Rangeの排他的論理和：Areas対応
'Rangeの排他的論理和：Areas対応
Function ExclusiveAreas(aRng1 As Range, aRng2 As Range) As Range
'(A - B) Or (B - A)
Set ExclusiveAreas = Intersect(Union(aRng1, aRng2), NotAreas(Intersect(aRng1, aRng2)))
'(A Or B) And Not(A And B)
'Set ExclusiveAreas = Union(ExceptAreas(aRng1, aRng2), ExceptAreas(aRng2, aRng1))
End Function
先にベン図で解説した2通りの求め方を記載し、片方はコメントアウトしています。
どちらを使っても良いでしょう。
処理順序の違いで、RangeのAddress文字列に違いが出ますが、
矩形に区切るときの区切り方の違いになりますので、全体の指し示すセル範囲は同じになります。
排他的論理和なので、全く同範囲のRangeを2つ指定した場合はNothingが戻されます。
どちらを使っても良いでしょう。
処理順序の違いで、RangeのAddress文字列に違いが出ますが、
矩形に区切るときの区切り方の違いになりますので、全体の指し示すセル範囲は同じになります。
Rangeオブジェクトの論理演算VBAの使い方とテスト
以上のVBAの関数Functionについて、使い方は簡単なので説明はしませんが、
結果検証のテスト用のVBAを提示しておきます。
一応説明しておきますが、Rangeオブジェクトは別々のシートのRangeは入れられません。
当然、UnionもIntersectも、別々のシートのRangeオブジェクトには対応していません。
したがって、今回作成した関数Functionも別々のシートのRangeオブジェクトには対応していません。
Range範囲をいろいろ変更してテストしてみてください。
このVBAは、今回の記事用に作成したものです。
したがって、使用実績が少ないためテストも不十分です。
もし不具合等あれば、ご連絡いただけるとありがたいです。
また、補集合の求め方などで、より良い方法があるよと言った情報は大歓迎です。
結果検証のテスト用のVBAを提示しておきます。
Sub 検証テスト()
Dim rng As Range, rng1 As Range, rng2 As Range
Set rng1 = Range("A1:B3,B7,D2:D5,E:F")
Set rng2 = Range("A2:D3,B4:E4")
Set rng = ExclusiveAreas(rng1, rng2)
Debug.Print rng.Address
rng.Select
End Sub
一応説明しておきますが、Rangeオブジェクトは別々のシートのRangeは入れられません。
当然、UnionもIntersectも、別々のシートのRangeオブジェクトには対応していません。
したがって、今回作成した関数Functionも別々のシートのRangeオブジェクトには対応していません。
このVBAは、今回の記事用に作成したものです。
したがって、使用実績が少ないためテストも不十分です。
もし不具合等あれば、ご連絡いただけるとありがたいです。
また、補集合の求め方などで、より良い方法があるよと言った情報は大歓迎です。
同じテーマ「マクロVBA技術解説」の記事
空文字列の扱い方と処理速度について（""とvbNullString）
VBAにおける変数のメモリアドレスについて
Evaluateメソッド（文字列の数式を実行します）
Rangeオブジェクトの論理演算（差集合と排他的論理和）
VBAで写真の撮影日時や音楽動画の長さを取得する
VBAでWindowsMediaPlayerを使い動画再生する
VBAでWEBカメラ操作する
VBAで電光掲示板を作成
ユーザーに絶対に停止させたくない場合のVBA設定
列幅・行高をDPI取得しピクセルで指定する
VBAでWMIの使い方について
新着記事NEW ・・・新着記事一覧を見る
ブール型（Boolean）のis変数・フラグについて｜VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する｜VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次｜エクセルの神髄(2024-03-20)
VBA10大躓きポイント（初心者が躓きやすいポイント）｜VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成｜ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。｜エクセル雑感(2024-02-17)
初級脱出10問パック｜VBA練習問題(2024-01-24)
累計を求める数式あれこれ｜エクセル関数応用(2024-01-22)
複数の文字列を検索して置換するSUBSTITUTE｜エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。｜エクセル雑感(2023-12-28)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.RangeとCellsの使い方｜VBA入門
4.ひらがな⇔カタカナの変換｜エクセル基本操作
5.繰り返し処理（For Next)｜VBA入門
6.変数宣言のDimとデータ型｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.Findメソッド（Find,FindNext,FindPrevious）｜VBA入門
- ホーム
- マクロVBA応用編
- マクロVBA技術解説
- Rangeオブジェクトの論理演算（差集合と排他的論理和）
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。