Copilotで高速化（配列化）｜階層連動VBA最終仕上げ | 40代シングルマザー派遣社員。正社員に転職するか悩む。

1 今回の業務内容と改善テーマ
2 なぜ遅くなるのか
3 今回の改善の考え方
4 実際のCopilotとのやり取り
- 4.1 利用者 → Copilot
- 4.2 Copilot → 利用者
5 この修正の本質
6 実務での変化
7 ここまでの完成形
8 まとめ
9 リンク

今回の業務内容と改善テーマ

前回は

・並び順の統一
・UI改善（選択してください）

ここまで対応しました。

この時点で「使いやすいツール」にはなっています。

ただし、まだ足りません。

実務で必ず出てくる問題があります。

それが遅いです。

データ件数が増えた瞬間に、一気にストレスになります。

今回のテーマは

・高速化（配列化）

ここをやります。

なぜ遅くなるのか

今までのコードは、毎回こうしています。

・シートを1行ずつ読む
・条件判定する
・Dictionaryに入れる

つまりセルを1件ずつ読んでいるこれが原因です。

Excel VBAで一番遅い処理はセルアクセスです。

ここを改善しない限り、高速化はできません。

今回の改善の考え方

やることはシンプルです。

シートを配列に読み込む

これだけです。

流れはこうなります。

① シート → 配列に一括読み込み
② 配列内でループ
③ 結果を作る

これで、体感レベルで速くなります。

今回取り扱うデータも経済産業省の公開データ「生産動態統計年報（2024年）」です。

■■■スポンサーリンク■■■

実際のCopilotとのやり取り

利用者 → Copilot

既存の階層連動コンボボックスのコードを高速化してください。

■修正内容
・シートのデータを配列に一括取得して処理する
・ループ内でCells参照を使わない
・既存のロジック（階層連動・UI・並び順・Dictionary）は維持

■その他
・可読性重視でコメント付き
・コードは省略せず全文提示してください

Copilot → 利用者

以下に、配列化による高速化を追加した完全版コードを提示します。

Option Explicit

'---------------------------------------------
' フォーム初期化：調査票名のみロード
'---------------------------------------------
Private Sub UserForm_Initialize()
    Load調査票名
End Sub

'---------------------------------------------
' 調査票名変更 → 項目名を再ロード
'---------------------------------------------
Private Sub cmb調査票名_Change()
    ResetCombo cmb項目名
    ResetCombo cmb品目名
    ResetCombo cmbアイテム名

    If cmb調査票名.ListIndex > 0 Then
        Load項目名 cmb調査票名.value
    End If
End Sub

'---------------------------------------------
' 項目名変更 → 品目名を再ロード
'---------------------------------------------
Private Sub cmb項目名_Change()
    ResetCombo cmb品目名
    ResetCombo cmbアイテム名

    If cmb調査票名.ListIndex > 0 And cmb項目名.ListIndex > 0 Then
        Load品目名 cmb調査票名.value, cmb項目名.value
    End If
End Sub

'---------------------------------------------
' 品目名変更 → アイテム名を再ロード
'---------------------------------------------
Private Sub cmb品目名_Change()
    ResetCombo cmbアイテム名

    If cmb調査票名.ListIndex > 0 _
       And cmb項目名.ListIndex > 0 _
       And cmb品目名.ListIndex > 0 Then

        Loadアイテム名 cmb調査票名.value, cmb項目名.value, cmb品目名.value
    End If
End Sub

'===========================================================
'  共通：コンボボックスを初期状態に戻す
'===========================================================
Private Sub ResetCombo(cmb As MSForms.ComboBox)
    cmb.Clear
    cmb.AddItem "選択してください"
    cmb.ListIndex = 0
End Sub

'===========================================================
'  共通：Dictionary → 昇順ソートした配列を返す
'===========================================================
Private Function SortedKeys(dic As Object) As Variant
    Dim arr As Variant
    arr = dic.Keys

    Dim i As Long, j As Long
    Dim tmp As String

    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If arr(i) > arr(j) Then
                tmp = arr(i)
                arr(i) = arr(j)
                arr(j) = tmp
            End If
        Next j
    Next i

    SortedKeys = arr
End Function

'===========================================================
'  調査票名のロード（配列高速版）
'===========================================================
Private Sub Load調査票名()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dataArr As Variant
    Dim dic As Object
    Dim i As Long
    Dim val As String

    Set ws = ThisWorkbook.Worksheets("data")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    '配列に一括取得（2行目～最終行）
    dataArr = ws.Range("A2:G" & lastRow).value

    Set dic = CreateObject("Scripting.Dictionary")

    '配列アクセスで高速化
    For i = 1 To UBound(dataArr, 1)
        val = Trim(dataArr(i, 4)) 'D列（調査票名）
        If val <> "" Then
            If Not dic.Exists(val) Then dic.Add val, True
        End If
    Next i

    ResetCombo cmb調査票名

    Dim arr As Variant, v As Variant
    arr = SortedKeys(dic)

    For Each v In arr
        cmb調査票名.AddItem v
    Next v
End Sub

'===========================================================
'  項目名のロード（配列高速版）
'===========================================================
Private Sub Load項目名(ByVal 調査票 As String)
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dataArr As Variant
    Dim dic As Object
    Dim i As Long
    Dim val As String

    Set ws = ThisWorkbook.Worksheets("data")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    dataArr = ws.Range("A2:G" & lastRow).value
    Set dic = CreateObject("Scripting.Dictionary")

    For i = 1 To UBound(dataArr, 1)
        If Trim(dataArr(i, 4)) = 調査票 Then
            val = Trim(dataArr(i, 5)) 'E列（項目名）
            If val <> "" Then
                If Not dic.Exists(val) Then dic.Add val, True
            End If
        End If
    Next i

    ResetCombo cmb項目名

    Dim arr As Variant, v As Variant
    arr = SortedKeys(dic)

    For Each v In arr
        cmb項目名.AddItem v
    Next v
End Sub

'===========================================================
'  品目名のロード（配列高速版）
'===========================================================
Private Sub Load品目名(ByVal 調査票 As String, ByVal 項目 As String)
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dataArr As Variant
    Dim dic As Object
    Dim i As Long
    Dim val As String

    Set ws = ThisWorkbook.Worksheets("data")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    dataArr = ws.Range("A2:G" & lastRow).value
    Set dic = CreateObject("Scripting.Dictionary")

    For i = 1 To UBound(dataArr, 1)
        If Trim(dataArr(i, 4)) = 調査票 _
           And Trim(dataArr(i, 5)) = 項目 Then

            val = Trim(dataArr(i, 6)) 'F列（品目名）
            If val <> "" Then
                If Not dic.Exists(val) Then dic.Add val, True
            End If
        End If
    Next i

    ResetCombo cmb品目名

    Dim arr As Variant, v As Variant
    arr = SortedKeys(dic)

    For Each v In arr
        cmb品目名.AddItem v
    Next v
End Sub

'===========================================================
'  アイテム名のロード（配列高速版）
'===========================================================
Private Sub Loadアイテム名(ByVal 調査票 As String, _
                           ByVal 項目 As String, _
                           ByVal 品目 As String)

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dataArr As Variant
    Dim dic As Object
    Dim i As Long
    Dim val As String

    Set ws = ThisWorkbook.Worksheets("data")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    dataArr = ws.Range("A2:G" & lastRow).value
    Set dic = CreateObject("Scripting.Dictionary")

    For i = 1 To UBound(dataArr, 1)
        If Trim(dataArr(i, 4)) = 調査票 _
           And Trim(dataArr(i, 5)) = 項目 _
           And Trim(dataArr(i, 6)) = 品目 Then

            val = Trim(dataArr(i, 7)) 'G列（アイテム名）
            If val <> "" Then
                If Not dic.Exists(val) Then dic.Add val, True
            End If
        End If
    Next i

    ResetCombo cmbアイテム名

    Dim arr As Variant, v As Variant
    arr = SortedKeys(dic)

    For Each v In arr
        cmbアイテム名.AddItem v
    Next v
End Sub

この修正の本質

今回やっていることは処理の場所を変えただけです。

Excel → 遅い
配列 → 速い

これだけです。

でもこの差は、数十倍になることもあります。

実務での変化

この修正を入れると

・大量データでもストレスなし
・クリックしても待たない
・操作がスムーズ

になります。

ここまで来ると、完全に業務ツールです。

ここまでの完成形

今回で

・階層連動
・条件付き抽出
・列の動的管理
・並び順
・UI改善
・高速化

全部揃いました。

最初の状態と比べると、別物です。

まとめ

今回は高速化（配列化）を追加しました。

重要なのは、速くする＝テクニックではないという点です。

・どこが遅いか理解する
・原因を潰す

これだけです。

そして今回も同じです。

コードは自分で書いていません。

・整理した
・指示した

それだけです。

ただしここまで来ると、AIに任せるだけではなく「何を改善するか考える力」が重要になります。

ここができると、一気に実務レベルを超えます。

■■■スポンサーリンク■■■

リンク

■■■スポンサーリンク■■■