テーブルから別テーブルへの転記 ② 連想配列による転記

前回はテーブル間の転記について、Findメソッドで検索した結果を用いて
行う方法を紹介した。
infoment.hatenablog.com
今回は、辞書(連想配列)を用いた転記方法に挑戦する。
f:id:Infoment:20210731144346p:plain

前回に続き、こちらのテーブルを使用する。
f:id:Infoment:20210731145200p:plain

テーブルBのコードと対になる数量を、テーブルA側の数量に反映する。
作戦は、こんな感じだ。

  1. テーブルBについて、コードをkey・数量をitemとして辞書に格納する。
  2. テーブルAのコードと辞書を照合。辞書に存在するならば、
    テーブルAの数量を辞書のitemで上書き。

上記をコード化したのがこちら。

Sub test2()
    
    ' テーブルA。
    Dim tb1 As ListObject
    Set tb1 = ActiveSheet.ListObjects(1)
    
    ' テーブルB
    Dim tb2 As ListObject
    Set tb2 = ActiveSheet.ListObjects(2)

    ' 作業用の辞書。
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")

    ' テーブルBの情報を辞書に格納する。
    Dim myKey As String
    Dim myItem As Long
    Dim i As Long
        For i = 1 To tb2.ListRows.Count
            myKey = tb2.ListColumns("コード").DataBodyRange.Cells(i)
            myItem = tb2.ListColumns("数量").DataBodyRange.Cells(i)
            Dict(myKey) = myItem
        Next
        
    ' テーブルAのコードと辞書を照合。辞書に存在するならば、
    ' テーブルAの数量を辞書のitemで上書き。
        For i = 1 To tb1.ListRows.Count
            myKey = tb1.ListColumns("コード").DataBodyRange.Cells(i)
            If Dict.Exists(myKey) Then
                tb1.ListColumns("数量").DataBodyRange.Cells(i) = Dict(myKey)
            End If
        Next

End Sub

実際に動作確認した結果がこちら。
f:id:Infoment:20210731150013g:plain

転記するデータ量が少ないなら、これでも全然問題ないと思う。
しかしデータ量が多くなると、セル毎にデータを上書きする時間が馬鹿に
ならない。塵も積もれば山となり、それなりの処理時間がかかってしまう。

ということで次回は、辞書と配列を組み合わせた方法について紹介します。

参考まで。