Rangeオブジェクトの論理演算(差集合と排他的論理和)
複数のRangeオブジェクトの重なっている範囲や、結合した範囲等々、
Rangeオブジェクトを集合として、その集合演算の結果のRangeオブジェクトが必要になってくる場合がVBAでは良くでてきます。
和集合:Unionメソッド
積集合:Intersectメソッド
この二つがありますが、
補集合、差集合、排他的論理和に該当するものはサポートされていません。
頻繁に必要になるものではないのですし、通常は何らかの別手段で実現しているものになります。
今回は、これら補集合、差集合、排他的論理和をVBAで自作してみました。
集合について
和集合、積集合、補集合、差集合、排他的論理和
これらをベン図で確認しておきましょう。
和集合・・・VBAの論理演算子は Or
積集合・・・VBAの論理演算子は And
補集合・・・VBAの論理演算子は Not
差集合・・・VBAの論理演算子はありません
排他的論理和・・・VBAの論理演算子は Xor
Rangeオブジェクトの論理演算の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
和集合の一つずつのセルについて、積集合に含まれていないものを集めているだけです。
多くの場合はこれで用が足りてしまうかもしれません。
現在のExcelは100万行あります。
それでも1列くらいなら上記VBAでもちょっと待てば処理が終了します。
しかし複数の列全体、例えば"E:J"くらいを上記VBAで処理したら・・・
時間がかかりすぎてしまって、実用に耐えられないことが分かるはずです。
このとき、最も面倒、かつ、これさえできれば他は何とかなるというのが補集合です。
例えば、(差集合は-で記述しています)
A - B
A And Not(B)
このように定義できます。
そして、差集合が出来れば排他的論理和も簡単に作成できます。
A Xor 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"))
(この=は代入ではなく等しいという意味です。)
したがって、以降のVBAを見るときには、
・矩形の1領域のRangeに対するプロシージャー
・複数のAreasを含んだRangeに対するプロシージャー
この2種類があることに注意してください。
和集合: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メソッド
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の排他的論理和:単一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
どちらを使っても良いでしょう。
処理順序の違いで、RangeのAddress文字列に違いが出ますが、
矩形に区切るときの区切り方の違いになりますので、全体の指し示すセル範囲は同じになります。
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 ・・・新着記事一覧を見る
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入門
- ホーム
- マクロVBA応用編
- マクロVBA技術解説
- Rangeオブジェクトの論理演算(差集合と排他的論理和)
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。