VBA DictionaryとListObjectを使った処理の高速化

Question

実現したいこと

VBAにて、DictionaryとListObjectを使った処理の高速化を実現したいです。
処理の概要とフローについては以下になります。

[概要]
独自クラスの配列(Dictionary)の中身をループでテーブルに書き込む

[フロー]

1. 別シートの他テーブルより、1行ずつ各列の値を独自クラスのプロパティに設定しDictionaryに格納
2. 書き込むテーブルの行を全削除（リセット）
3. Dictionaryをループしてテーブルの先頭行に各プロパティの値を設定、行を増やす
4. Dictionaryの最後まで3を繰り返す　★ここが重い
5. シートの最適化

発生している問題・分からないこと

ループ以外にも処理を行っていますが、そちらは1秒もかからず終了していて、Rangeを参照している処理に時間がかかっているようなのでこちらのリファクタリングを行いたいです。具体的には30行を書き込むのみ40秒ほどかかりますので短縮したいです。

該当のソースコード

Sub reflection()
    Application.ScreenUpdating = False
    Call AP_ref.reflection '他のシートの最適化、メソッドの記載は省略
    Call AR_ref.reflection '他のシートの最適化、メソッドの記載は省略

    Dim allTable As ListObject
    Set allTable = ActiveWorkbook.Worksheets("全取引").ListObjects("All")

    Call sortTable '他のシートのソート、メソッドの記載は省略

    Dim allSlipList As Object: Set allSlipList = getSlips() 'フロー：1.  別シートの他テーブルより、1行ずつ各列の値を独自クラスのプロパティに設定しDictionaryに格納、メソッドの記載は省略

    'フロー：2.   書き込むテーブルの行を全削除（リセット）
    With allTable
        If Not .DataBodyRange Is Nothing Then
            .DataBodyRange.Delete
        End If
    End With

    Dim allSlipListKey As Variant
    Dim yayoi As yayoi
    ' フロー：3.  Dictionaryをループしてテーブルの先頭行に各プロパティの値を設定、行を増やす
    For Each allSlipListKey In allSlipList.Keys
        Set yayoi = allSlipList(allSlipListKey)
        Range(tableRow, 1) = yayoi.columns("id_Flag")
        With allTable
            ' .Range(.Range.Rows.Count, 1) = yayoi.columns("id_Flag")
            ' .Range(.Range.Rows.Count, 2) = yayoi.columns("slipNum")
            ' .Range(.Range.Rows.Count, 3) = yayoi.columns("financStat")
            ' .Range(.Range.Rows.Count, 4) = yayoi.columns("slipDay")
            ' .Range(.Range.Rows.Count, 5) = yayoi.columns("debitName")
            ' .Range(.Range.Rows.Count, 6) = yayoi.columns("debitSub")
            ' .Range(.Range.Rows.Count, 7) = yayoi.columns("debitDep")
            ' .Range(.Range.Rows.Count, 8) = yayoi.columns("debitTaxType")
            ' .Range(.Range.Rows.Count, 9) = yayoi.columns("debitAmo")
            ' .Range(.Range.Rows.Count, 10) = yayoi.columns("debitTax")
            ' .Range(.Range.Rows.Count, 11) = yayoi.columns("creditName")
            ' .Range(.Range.Rows.Count, 12) = yayoi.columns("creditSub")
            ' .Range(.Range.Rows.Count, 13) = yayoi.columns("creditDep")
            ' .Range(.Range.Rows.Count, 14) = yayoi.columns("creditTaxType")
            ' .Range(.Range.Rows.Count, 15) = yayoi.columns("creditAmo")
            ' .Range(.Range.Rows.Count, 16) = yayoi.columns("creditTax")
            ' .Range(.Range.Rows.Count, 17) = yayoi.columns("summary")
            ' .Range(.Range.Rows.Count, 18) = yayoi.columns("num")
            ' .Range(.Range.Rows.Count, 19) = yayoi.columns("settlement")
            ' .Range(.Range.Rows.Count, 20) = yayoi.columns("slipType")
            ' .Range(.Range.Rows.Count, 21) = yayoi.columns("origin")
            ' .Range(.Range.Rows.Count, 22) = yayoi.columns("memo")
            ' .Range(.Range.Rows.Count, 23) = yayoi.columns("tag1")
            ' .Range(.Range.Rows.Count, 24) = yayoi.columns("tag2")
            ' .Range(.Range.Rows.Count, 25) = yayoi.columns("adjustment")
            .ListRows.Add
        End With
        tableRow = tableRow + 1
    Next `フロー：4. Dictionaryの最後まで3を繰り返す
    
    `フロー：5. シートの最適化
    allTable.Range.AutoFilter Field:=3
    allTable.Sort.SortFields.Clear
    allTable.Sort.SortFields.Add2 key:= _
        Range("All[[#All],[日付]]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With allTable.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

Application.ScreenUpdatingの設定で高速化対応はしていますが、テーブルの処理の高速化についてはまだ調査中です。

補足

修正後の該当ソースコード

Dim rangeStr As String: rangeStr = "A2:Y" & allSlipList.Count
    ReDim tableArray(yayoiCount, 25) As Variant
    For Each allSlipListKey In allSlipList.Keys
        Set yayoi = allSlipList(allSlipListKey)
        tableArray(x, 0) = yayoi.columns("id_Flag")
        tableArray(x, 1) = yayoi.columns("slipNum")
        tableArray(x, 2) = yayoi.columns("financStat")
        tableArray(x, 3) = yayoi.columns("slipDay")
        tableArray(x, 4) = yayoi.columns("debitName")
        tableArray(x, 5) = yayoi.columns("debitSub")
        tableArray(x, 6) = yayoi.columns("debitDep")
        tableArray(x, 7) = yayoi.columns("debitTaxType")
        tableArray(x, 8) = yayoi.columns("debitAmo")
        tableArray(x, 9) = yayoi.columns("debitTax")
        tableArray(x, 10) = yayoi.columns("creditName")
        tableArray(x, 11) = yayoi.columns("creditSub")
        tableArray(x, 12) = yayoi.columns("creditDep")
        tableArray(x, 13) = yayoi.columns("creditTaxType")
        tableArray(x, 14) = yayoi.columns("creditAmo")
        tableArray(x, 15) = yayoi.columns("creditTax")
        tableArray(x, 16) = yayoi.columns("summary")
        tableArray(x, 17) = yayoi.columns("num")
        tableArray(x, 18) = yayoi.columns("settlement")
        tableArray(x, 19) = yayoi.columns("slipType")
        tableArray(x, 20) = yayoi.columns("origin")
        tableArray(x, 21) = yayoi.columns("memo")
        tableArray(x, 22) = yayoi.columns("tag1")
        tableArray(x, 23) = yayoi.columns("tag2")
        tableArray(x, 24) = yayoi.columns("adjustment")
        If isFirstLoop = False Then
           allTable.ListRows.Add
        End If
        isFirstLoop = False

        x = x + 1
    Next
Range(rangeStr) = tableArray

Answer 1

挙動が確認できないので当てずっぽうですが
cellにひとつひとつ値を与えるのではなく、配列にいれて一気に設定すると早いです

Dim a(10, 10)
For i = 0 To 9
For j = 0 To 9
a(i, j) = i + j * 10
Next
Next
Range("a1:j10") = a

セル指定の汎用化

※上記が決め打ちすぎたので一応追記しておきます

Dim a()

Let x = 8
Let y = 7
Let offset_x = 2
Let offset_y = 3

ReDim a(x, y)

For i = 0 To x - 1
For j = 0 To y - 1
a(i, j) = i + j * x
Next
Next
Range(Cells(1 + offset_x, 1 + offset_y), Cells(x + offset_x, y + offset_y)) = a

Comments

[user202102]

ありがとうございます。補足の修正後の該当ソースコードの通り、配列にいれて一気に設定することで30秒が6秒ほどになりました。
ただ配列の要素が800程度だと80秒くらいですが、VBAの速度的にはこんなものなのでしょうか。

[yambejp]

あとは適当にブレークポイントをいれて時間計測して効率の悪い箇所を探してみてください。
場合によってはその箇所をピンポイントでリファクタリングできるかもしれません
ScreenUpdatingなども設定されているようですし、小技でできることはこんなものかと。

[user202102]

上記、お返事ありがとうございます。
「allTable.ListRows.Add」の部分をまとめて行追加することで更に短縮できました。
結果的に800行で4秒ほどになりました。先述していた80秒のうち70秒は省略していた処理が影響しておりました。
大変助かりました、ベストアンサーとさせていただきます。