範囲Bから範囲Aを除外する
先日、高校数学の「集合」を、VBAで理解することを試みた。
infoment.hatenablog.com
眺めていて、ふと思った。これって、範囲の引き算に使えないか?
範囲Bから範囲Aを取り除いた、新たな範囲を取得したい。
作戦は至って単純で、こんな感じだ。
- 範囲Aと範囲Bのアドレスを格納した配列Aと配列Bを作成する。
- 配列B-配列Aの差集合を取得。
- 取得結果の各アドレスを、Unionメソッドで合成する。
ということで今回、先日作成したクラスモジュール:MathSetに、
以下二つのFunctionプロシージャを追加してみた。
クラスモジュール(MathSet)
指定範囲のアドレスを格納した配列。
Public Function GetRangeAddress(target_range As Range) As Variant Dim arr As Variant ' 配列のサイズをtarget_rangeと揃えるために、 ' 一旦、target_rangeの値を配列に格納する。 ' ※これらの値は、その後全て上書きされる。 arr = target_range Dim rIndex As Long Dim cIndex As Long For rIndex = 1 To target_range.Rows.Count For cIndex = 1 To target_range.Columns.Count arr(rIndex, cIndex) = target_range.Cells(rIndex, cIndex).Address Next Next GetRangeAddress = arr End Function
次いで、Unionメソッドを用いて、このアドレスの範囲を取得する。
' 範囲Bから範囲Aを除いた、新たな範囲を取得。 Public Function GetDifferenceRange(Range_A As Range, _ Range_B As Range) As Range Dim set_A As Variant set_A = GetRangeAddress(Range_A) Dim set_B As Variant set_B = GetRangeAddress(Range_B) Dim DifferenceAddressArray As Variant ' とにかく除去できれば良いので、set_Aがset_Bの部分集合で ' あるか否かは問わない(=3つ目の引数をFalseとする)。 DifferenceAddressArray = GetDifferenceSet(set_A, set_B, False) If UBound(DifferenceAddressArray) = -1 Then Exit Function Dim a As Variant Dim TempRange As Range For Each a In DifferenceAddressArray If TempRange Is Nothing Then Set TempRange = Range(a) Else Set TempRange = Union(TempRange, Range(a)) End If Next Set GetDifferenceRange = TempRange End Function
それでは、早速実験してみよう。
↓ この赤い範囲から、
↓ この黄色い範囲を除外したい。
テスト用のコードがこちら。
Sub test() Dim MS As VBAProject.MathSet Set MS = New VBAProject.MathSet Dim Range_A As Range Set Range_A = Range("B2:C3") Dim Range_B As Range Set Range_B = Range("A1:D4") Dim Range_C As Range Set Range_C = MS.GetDifferenceRange(Range_A, Range_B) Range_C.Interior.Color = vbRed End Sub
↓ 結果がこちら。
テーブル形式にできない表について、表の1行目を除く範囲を
取得したい場合などに使えそうです。
参考まで。