タグ: 真部分集合

EXCEL VBAで2つの1次元配列が等しいか調べ，配列の差分を求める

　EXCEL VBA において，2 つの配列が等しいか否か調べたいことはよくあります．更に2つの配列の差分，つまり互いに重複しない要素を取り出したいという需要もあります．今回は配列の差分を求めるコードを紹介します．

　2つの配列が等しいかをまず調べ，等しくない場合に次に一方が他方の真部分集合であるか否かを調べます．最後に配列の差分を求めます．この順になっているのは全く同じ2つの配列の差分は空集合となって解が求まらないためであり，引き算される配列が引き算する配列の真部分集合の場合にも結果が空集合となり解が求まらないためです．

Array1&Array2

　Array1 の配列要素全体を A, Array2 の配列要素全体を B とすると Array1 から Array2 を差し引いた差分は下式で表現されます．

Array1 - Array2 = A\ AND\ (not B) = A \cap \neg B

　二重ループによりそれぞれの要素を比較して一致した数を求めていますが，これは積集合を取っていることに他なりません．EXCELワークシートにおいて数式の参照元の最初のセルおよび参照先の最後のセルを取得するでも述べましたが，2つの集合の和集合と積集合の要素数が等しければ元の2つの集合は全く同じです．ここでのロジックは積集合の要素数と元の集合の要素数が等しければ元の2つの集合は等しい筈であるとの前提に立っています．

Option Explicit

Function COMPARE_ARRAY(ByRef Array1() As String, ByRef Array2() As String) As Boolean
    Dim i   As Long
    Dim j   As Long
    Dim k   As Long
    k = 0
    For i = LBound(Array1) To UBound(Array1)
        For j = LBound(Array2) To UBound(Array2)
            If Array1(i) = Array2(j) Then
                k = k + 1
            End If
        Next j
    Next i
    If i = j And i = k Then
        COMPARE_ARRAY = True
    Else
        COMPARE_ARRAY = False
    End If
End Function

Function PROPERSUBSET_ARRAY(ByRef Array1() As String, ByRef Array2() As String) As Boolean
    Dim i   As Long
    Dim j   As Long
    Dim k   As Long
    k = 0
    For i = LBound(Array1) To UBound(Array1)
        For j = LBound(Array2) To UBound(Array2)
            If Array1(i) = Array2(j) Then
                k = k + 1
            End If
        Next j
    Next i
    If k = i Then
        PROPERSUBSET_ARRAY = True
    Else
        PROPERSUBSET_ARRAY = False
    End If
End Function

　下記関数では第 3 引数の Compare の指定により Array1 から Array2 の差分を求めるか，Array2 から Array1 の差分を求めるかを指定しています．但し，配列内の要素にもともと空白文字列があった場合にはうまく動作しません．

Function EXCEPT_ARRAY(ByRef Array1() As String, ByRef Array2() As String, ByVal Compare As Boolean) As String()
    Dim i               As Long
    Dim j               As Long
    Dim k               As Long
    Dim InternalAr1()   As String
    Dim InternalAr2()   As String
    Dim Ar1Ar()         As String
    Dim Ar2Ar()         As String
    InternalAr1 = Array1
    InternalAr2 = Array2
    For i = LBound(InternalAr1) To UBound(InternalAr1)
        For j = LBound(InternalAr2) To UBound(InternalAr2)
            If InternalAr1(i) = InternalAr2(j) Then
                InternalAr1(i) = ""
                InternalAr2(j) = ""
                k = k + 1
            End If
        Next j
    Next i
    k = 0
    For i = LBound(InternalAr1) To UBound(InternalAr1)
        If InternalAr1(i) = "" Then
        Else
            ReDim Preserve Ar1Ar(k)
            Ar1Ar(k) = InternalAr1(i)
            k = k + 1
        End If
    Next i
    k = 0
    For j = LBound(InternalAr2) To UBound(InternalAr2)
        If InternalAr2(j) = "" Then
        Else
            ReDim Preserve Ar2Ar(k)
            Ar2Ar(k) = InternalAr2(j)
            k = k + 1
        End If
    Next j
    If Compare Then
        EXCEPT_ARRAY = Ar1Ar
    Else
        EXCEPT_ARRAY = Ar2Ar
    End If
End Function

参照：
EXCELワークシートにおいて数式の参照元の最初のセルおよび参照先の最後のセルを取得する