テーブルから別テーブルへの転記 ③ 配列と連想配列の組合せ ~その10.使用例:其の二~

先日、テーブル間データ転記のためにまとめたクラスモジュールについて、
その使用例を一つご紹介した。
infoment.hatenablog.com

今回も、別の使用例を一つ。
f:id:Infoment:20210812225338p:plain

今日は、三つのテーブルを使ってみよう。

  1. テーブルD:転記元
  2. テーブルA:転記先
  3. テーブルB:退避先

f:id:Infoment:20210812225729p:plain

以下全てに於いて、キーとなるのは「コード」列の情報とする。

まずテーブルA:転記先にあって、テーブルD:転記元にないレコードは、
テーブルAで管理すべき対象から除外されたとして、テーブルB:退避先へ
転記する。
f:id:Infoment:20210812230340p:plain

次いで、テーブルD:転記元から、テーブルA:転記先へ転記を行う。
テーブルD:転記元にあって、テーブルA:転記先にないコードがあれば、
レコード単位でテーブルA:転記先に追加する。

また、テーブルD:転記元に無くて、テーブルA:転記先にあるコードに
ついては、コードを削除する。
f:id:Infoment:20210812230920p:plain

最後に、テーブルA:転記先のコード列について、空白があれば行単位で
除去する。
f:id:Infoment:20210812231225p:plain

これら一連の処理を記したマクロがこちら。

Sub test()
    
    Dim MS As VBAProject.MathSet
    Set MS = New VBAProject.MathSet
    
    ' 各テーブルを変数にセット。
    Dim Tb_A As ListObject: Set Tb_A = ActiveSheet.ListObjects("テーブルA")
    Dim Tb_B As ListObject: Set Tb_B = ActiveSheet.ListObjects("テーブルB")
    Dim Tb_D As ListObject: Set Tb_D = ActiveSheet.ListObjects("テーブルD")
    
    ' テーブルA ⇒ テーブルBへ退避。
    ' テーブルAにあって、テーブルDにないコードを求める。
    Dim SrcArr As Variant
        SrcArr = Tb_D.ListColumns("コード").DataBodyRange
    Dim DstArr As Variant
        DstArr = Tb_A.ListColumns("コード").DataBodyRange
    Dim Result As Variant
        Result = MS.GetDifferenceSet(SrcArr, DstArr, False)
    
        With Tb_B.ListRows.Add
            .Range(1).Resize(UBound(Result) + 1) _
                = WorksheetFunction.Transpose(Result)
        End With
        MS.Transcription_Tb2Tb_All src_tb:=Tb_A, _
                                   dst_tb:=Tb_B, _
                                   src_key:="コード"
    
    ' テーブルD ⇒ テーブルAへ転記。
        MS.Transcription_Tb2Tb_All src_tb:=Tb_D, _
                                   dst_tb:=Tb_A, _
                                   src_key:="コード", _
                                   add_new_record:=True, _
                                   del_key:=True
    
    ' テーブルAのコード列について、空白セルを行ごと削除。
    Dim i As Long
        For i = Tb_A.ListRows.Count To 1 Step -1
            If Tb_A.ListRows(i).Range(1) = vbNullString Then
                Tb_A.ListRows(i).Delete
            End If
        Next

End Sub

結果がこちら。
f:id:Infoment:20210812233615g:plain

意図したとおり、退避と転記および削除を行うことができた。
例えばテーブルAが出荷管理台帳で、「みかん」と「ぶどう」が出荷済みのため、
最新情報として生産管理システム等から出力されたテーブルDに無い場合、今回
まとめたクラスモジュールが有効かもしれない。

長々と続けてきたが、今回のシリーズはこれでおしまい。

参考まで。