テーブルから別テーブルへの転記 ② 連想配列による転記
前回はテーブル間の転記について、Findメソッドで検索した結果を用いて
行う方法を紹介した。
infoment.hatenablog.com
今回は、辞書(連想配列)を用いた転記方法に挑戦する。
前回に続き、こちらのテーブルを使用する。
テーブルBのコードと対になる数量を、テーブルA側の数量に反映する。
作戦は、こんな感じだ。
- テーブルBについて、コードをkey・数量をitemとして辞書に格納する。
- テーブル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
実際に動作確認した結果がこちら。
転記するデータ量が少ないなら、これでも全然問題ないと思う。
しかしデータ量が多くなると、セル毎にデータを上書きする時間が馬鹿に
ならない。塵も積もれば山となり、それなりの処理時間がかかってしまう。
ということで次回は、辞書と配列を組み合わせた方法について紹介します。
参考まで。