変更前と変更後の違いをまとめた配列を作成 - Infomentのブログ～Excel VBA奮闘記～

先日改修した自作のクラスモジュール：ArrayEditについて。
infoment.hatenablog.com
今日は、必要に迫られて更に改修した、というお話。
f:id:Infoment:20210103105838p:plain

今までは、二つの表を比較する際、各レコードについて

変更
削除
追加

の各情報を「⇒」で表していた。
【元データ】
f:id:Infoment:20210103110326p:plain

【比較結果】
f:id:Infoment:20210103111817p:plain

しかしこれだと、「⇒」で変化を表したセルが全て文字列になってしまう。
業務で使用するうち、これでは都合の悪い場面に遭遇した。

そこで、今まで空配列を返していたinvers_arrayを活用することにした。

edited_array ⇒ 今までどおり、比較結果を含む配列
invers_array ⇒ 変更前と変更後の各情報をテーブル形式で持つ配列

クラスモジュール（ArrayEdit）。

' 二つの配列を比較して、変更・追加・削除状況を調べた結果を返す。
' この関数は、二つの配列がユニークなキー情報を持っている場合に限定して使用可能。
Public Function CompareResultArray(arr As Variant, _
                          Optional key_index As Long = 1, _
                          Optional select_array As SelectArray = case_source) As Variant

        tempArray = GetTempArray(select_array)
    
        ' 調査結果を記すため、配列の最後尾に一列追加。
'        ColumnCutAndPaste cMax, cMax, xlCopy, cpInsert, , select_array
        ColumnInsertBlank cMax + 1, , select_array
        tempArray = edited_array
        
        ' まず最終列に全て、「削除」をセット。
        ' 削除で無ければ、結果を上書きする。
        For r = rMin To rMax
            edited_array(r, cMax) = "削除"
        Next
    
    ' 比較する配列のループカウンタ。
    Dim j As Long
    ' 検索キーワードが見つかった行番号。
    Dim k As Long
    ' 変更点の有無を知るためのカウンタ。
    Dim Counter As Long
    ' 表形式で変更点を返すための配列。
    Dim CounterForReport As Long
    Dim ReportArray() As Variant
    ReDim ReportArray(1 To rMax * cMax, 1 To 5)
        ReportArray(1, 1) = "キー情報"
        ReportArray(1, 2) = "項目名"
        ReportArray(1, 3) = "変更前"
        ReportArray(1, 4) = "変更後"
        ReportArray(1, 5) = "確認日"
        CounterForReport = 2
    
        For j = LBound(arr) To UBound(arr)
            Counter = 0
            
            ' キー情報が調査対象となる配列に存在しない場合、それは
            ' 今回、対象配列に追加されたことを意味する。
            ' 従って、調査したレコードをそのままコピーし、最終列に
            ' 「追加」をセットする。
            If ColumnFind(arr(j, key_index), , key_index) Is Nothing Then
                RowAdd WorksheetFunction.index(arr, j, 0), , cpInsert, case_edited
                edited_array(rMax, cMax) = "追加"
            
            ' キー情報が対象配列に存在する場合、レコードの内容を
            ' 一つずつ比較する。一致しないものがあれば、「⇒」で
            ' つないでcounterをカウントアップ。
            Else
                k = ColumnFind(arr(j, key_index), , key_index).Item(1)
                For c = cMin To cMax - 1
                    If edited_array(k, c) <> arr(j, c) Then
                        
                        ReportArray(CounterForReport, 1) = arr(j, key_index)
                        ReportArray(CounterForReport, 2) = arr(1, c)
                        ReportArray(CounterForReport, 3) = edited_array(k, c)
                        ReportArray(CounterForReport, 4) = arr(j, c)
                        ReportArray(CounterForReport, 5) = Date
                        
                        edited_array(k, c) = edited_array(k, c) & " ⇒ " & arr(j, c)
                        Counter = Counter + 1
                        CounterForReport = CounterForReport + 1
                    End If
                Next
                
            ' カウンターが０ならば、レコード内容に変更なしを意味する。
            ' 従って、最終列の文字「削除」を削除する。
                If Counter = 0 Then
                    edited_array(k, cMax) = vbNullString
            
            ' カウンターが１以上の場合、何某かの変更があったことを意味する。
            ' 従って、最終列の文字を「変更」に変更する。
                Else
                    edited_array(k, cMax) = "変更"
                End If
            End If
        Next
        
    Dim TempReportArray() As Variant
    ReDim TempReportArray(1 To CounterForReport - 1, 1 To 5)
        For i = 1 To UBound(TempReportArray)
            For j = 1 To 5
                TempReportArray(i, j) = ReportArray(i, j)
            Next
        Next
        
        CompareResultArray = edited_array
        invers_array = TempReportArray
    
End Function

それでは早速、テストしてみよう。
コードをキーに、二つのテーブル内容を比較している。

Sub てすと()
    Dim arr(2) As Variant
        arr(1) = Range("A1:D4")
        arr(2) = Range("A6:D9")
        
        With New VBAProject.ArrayEdit
            .source_array = arr(1)
            .CompareResultArray arr:=arr(2), _
                                key_index:=3
            
            ' 比較結果。追加および削除情報を含む。
            .PasteArray destination:="F1", _
                        paste_type:=ptTable, _
                        column_autofit:=True, _
                        select_array:=case_edited
                        
            ' 比較結果。追加および削除情報は含まない。
            .PasteArray destination:="F7", _
                        paste_type:=ptTable, _
                        column_autofit:=True, _
                        select_array:=case_invers
        End With
End Sub