範囲Bから範囲Aを除外する

先日、高校数学の「集合」を、VBAで理解することを試みた。
infoment.hatenablog.com
眺めていて、ふと思った。これって、範囲の引き算に使えないか?
f:id:Infoment:20210613225340p:plain

範囲Bから範囲Aを取り除いた、新たな範囲を取得したい。
作戦は至って単純で、こんな感じだ。

  1. 範囲Aと範囲Bのアドレスを格納した配列Aと配列Bを作成する。
  2. 配列B-配列Aの差集合を取得。
  3. 取得結果の各アドレスを、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

それでは、早速実験してみよう。
↓ この赤い範囲から、
f:id:Infoment:20210613230455p:plain
↓ この黄色い範囲を除外したい。
f:id:Infoment:20210613230619p:plain
テスト用のコードがこちら。

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

↓ 結果がこちら。
f:id:Infoment:20210613230814p:plain

テーブル形式にできない表について、表の1行目を除く範囲を
取得したい場合などに使えそうです。

参考まで。