VBA技術解説
Rangeオブジェクトの論理演算(差集合と排他的論理和)

ExcelマクロVBAの問題点と解決策、VBAの技術的解説
公開日:2020-01-10 最終更新日:2020-10-30

Rangeオブジェクトの論理演算(差集合と排他的論理和)


複数のRangeオブジェクトの重なっている範囲や、結合した範囲等々、
Rangeオブジェクトを集合として、その集合演算の結果のRangeオブジェクトが必要になってくる場合がVBAでは良くでてきます。


マクロVBAで標準でサポートされているものとしては、
和集合:Unionメソッド
積集合:Intersectメソッド
この二つがありますが、
補集合、差集合、排他的論理和に該当するものはサポートされていません。

A範囲のうち、B範囲に含まれない範囲に対して、何らかの処理をしたいというような場合です。
頻繁に必要になるものではないのですし、通常は何らかの別手段で実現しているものになります。
今回は、これら補集合、差集合、排他的論理和をVBAで自作してみました。

集合について

まずは集合の基礎として、
和集合、積集合、補集合、差集合、排他的論理和
これらをベン図で確認しておきましょう。

和集合・・・VBAの論理演算子は Or

VBA マクロ Rangeの論理演算

積集合・・・VBAの論理演算子は And

VBA マクロ Rangeの論理演算

補集合・・・VBAの論理演算子は Not

VBA マクロ Rangeの論理演算

差集合・・・VBAの論理演算子はありません

VBA マクロ Rangeの論理演算

排他的論理和・・・VBAの論理演算子は Xor

VBA マクロ Rangeの論理演算

Rangeオブジェクトの論理演算のVBAについて

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を作ろうという事です。
このとき、最も面倒、かつ、これさえできれば他は何とかなるというのが補集合です。
例えば、(差集合は-で記述しています)

A - B

A - Bは、
A And Not(B)
このように定義できます。

そして、AndはIntersectがあるので、Notさえあれば差集合は完成します。
そして、差集合が出来れば排他的論理和も簡単に作成できます。

A Xor B

A Xor Bは、
(A - B) Or (B - A)

A - B
VBA マクロ Rangeの論理演算

B - A
VBA マクロ Rangeの論理演算

(A - B) Or (B - A)
VBA マクロ Rangeの論理演算

さらに、このような論理式でも表せます。
(A Or B) And Not(A And B)

A And B
VBA マクロ Rangeの論理演算

Not(A And B)
VBA マクロ Rangeの論理演算

A Or B
VBA マクロ Rangeの論理演算

(A Or B) And Not(A And B)
VBA マクロ Rangeの論理演算


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種類があることに注意してください。

和集合:Unionメソッド

Rangeオブジェクトの和集合はApplicationのUnionメソッドを使用します。
Unionメソッドの詳細については以下をご覧ください。

第103回.UnionメソッドとAreasプロパティ|VBA入門
・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メソッド ・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 マクロ Rangeの論理演算

この①②③④の4つの領域の和集合になります。
上記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オブジェクトの論理演算VBAの使い方とテスト

以上のVBAの関数Functionについて、使い方は簡単なので説明はしませんが、
結果検証のテスト用の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オブジェクトには対応していません。

Range範囲をいろいろ変更してテストしてみてください。
このVBAは、今回の記事用に作成したものです。
したがって、使用実績が少ないためテストも不十分です。
もし不具合等あれば、ご連絡いただけるとありがたいです。
また、補集合の求め方などで、より良い方法があるよと言った情報は大歓迎です。



同じテーマ「マクロVBA技術解説」の記事

空文字列の扱い方と処理速度について(""とvbNullString)
VBAにおける変数のメモリアドレスについて
Evaluateメソッド(文字列の数式を実行します)
Rangeオブジェクトの論理演算(差集合と排他的論理和)
VBAで写真の撮影日時や音楽動画の長さを取得する
VBAでWindowsMediaPlayerを使い動画再生する
VBAでWEBカメラ操作する
VBAで電光掲示板を作成
ユーザーに絶対に停止させたくない場合のVBA設定
列幅・行高をDPI取得しピクセルで指定する
VBAでWMIの使い方について


新着記事NEW ・・・新着記事一覧を見る

TRIMRANGE関数(セル範囲をトリム:端の空白セルを除外)|エクセル入門(2024-08-30)
正規表現関数(REGEXTEST,REGEXREPLACE,REGEXEXTRACT)|エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない|エクセル雑感(2024-04-11)
ブール型(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)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.繰り返し処理(For Next)|VBA入門
3.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
4.変数宣言のDimとデータ型|VBA入門
5.RangeとCellsの使い方|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.セルのクリア(Clear,ClearContents)|VBA入門
8.メッセージボックス(MsgBox関数)|VBA入門
9.条件分岐(Select Case)|VBA入門
10.ブック・シートの選択(Select,Activate)|VBA入門




このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。


このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ