はじめに

100万行のExcelをVBAで処理したとき：

数分かかる
途中で「応答なし」
フリーズする

しかし実際は違います。

遅いのはVBAではなく「書き方」です。

本記事では：

テストデータ（100万行）を生成
3パターンで処理速度を比較
なぜ速くなるのかを解説

します。

想定シナリオ

売上データ（100万行）：

日付	商品	売上
2026/3/1	商品1	1000
2026/3/2	商品2	2000
…	…	…

商品ごとの売上合計を算出します。

STEP1：テストデータ生成（100万行）

Sub Generate_Test_Data()

    Dim startTime As Long
    startTime = Timer
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(1)
    ws.Cells.Clear

    ' ヘッダー設定
    ws.Range("A1:C1").Value = Array("日付", "商品", "売上")

    Dim rowCount As Long
    rowCount = 1000000 ' 100万行

    Dim data()
    ReDim data(1 To rowCount, 1 To 3)

    Dim i As Long
    Randomize
    For i = 1 To rowCount
        ' 日付（ダミー）
        data(i, 1) = DateSerial(2021 + (i Mod 5), (i Mod 12) + 1, (i Mod 28) + 1)

        ' 商品（商品1～商品100をランダム生成）
        data(i, 2) = "商品" & Int(Rnd * 100 + 1)

        ' 売上（1～10000）
        data(i, 3) = Int(Rnd * 10000) + 1
    Next i

    ' 一括書き込み（高速）
    ws.Range("A2").Resize(rowCount, 3).Value = data

    Msgbox "データ生成時間：" & (Timer - startTime) & " 秒"

End Sub

STEP2： 3パターン比較

パターン①：Dictionaryなし（最も遅い）

Sub Slow_Process_NoDictionary()

    Dim startTime As Long
    startTime = Timer
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(1)

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' 出力エリア初期化
    ws.Range("E:F").ClearContents
    ws.Range("E1:F1").Value = Array("商品", "売上合計")

    Dim i As Long, j As Long
    Dim found As Boolean
    Dim lastResultRow As Long

    lastResultRow = 1 ' 結果の最終行

    For i = 2 To lastRow

        Dim key As String
        key = ws.Cells(i, 2).Value ' 商品名取得

        found = False

        ' ===== 結果エリアを毎回ループ検索（遅い原因）=====
        For j = 2 To lastResultRow
            If ws.Cells(j, 5).Value = key Then
                ' 見つかった場合：加算
                ws.Cells(j, 6).Value = ws.Cells(j, 6).Value + ws.Cells(i, 3).Value
                found = True
                Exit For
            End If
        Next j

        ' 見つからない場合：新規追加
        If Not found Then
            lastResultRow = lastResultRow + 1
            ws.Cells(lastResultRow, 5).Value = key
            ws.Cells(lastResultRow, 6).Value = ws.Cells(i, 3).Value
        End If

    Next i

    MsgBox "Dictionaryなし：" & (Timer - startTime) & " 秒"

End Sub

■ 特徴

毎回検索 → 非効率
時間計算量：O(n²)

パターン②：Dictionaryあり（中間）

Sub Slow_Process()

    Dim startTime As Long
    startTime = Timer
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(1)

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' Dictionaryで高速検索
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    ws.Range("E:F").ClearContents
    ws.Range("E1:F1").Value = Array("商品", "売上合計")

    Dim i As Long
    For i = 2 To lastRow

        Dim key As String
        key = ws.Cells(i, 2).Value ' 商品

        ' ===== Dictionaryで即検索（高速）=====
        If dict.exists(key) Then
            dict(key) = dict(key) + ws.Cells(i, 3).Value
        Else
            dict.Add key, ws.Cells(i, 3).Value
        End If

    Next i

    ' ===== 結果をシートへ出力（Cells単位 → やや遅い）=====
    Dim rowIndex As Long
    rowIndex = 2

    Dim k As Variant
    For Each k In dict.Keys
        ws.Cells(rowIndex, 5).Value = k
        ws.Cells(rowIndex, 6).Value = dict(k)
        rowIndex = rowIndex + 1
    Next k

    MsgBox "Dictionaryあり：" & (Timer - startTime) & " 秒"

End Sub

■ 特徴

検索は高速
しかしCellsアクセスが多い

パターン③：完全最適化（最速）

Sub Fast_Process()

    Dim startTime As Long
    startTime = Timer
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(1)

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' 高速化設定（描画・再計算停止）
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    ' ===== データを一括取得（ここが重要）=====
    Dim data As Variant
    data = ws.Range("A2:C" & lastRow).Value

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Dim i As Long
    For i = 1 To UBound(data, 1)

        Dim key As String
        key = data(i, 2) ' メモリ内アクセス（高速）

        If dict.exists(key) Then
            dict(key) = dict(key) + data(i, 3)
        Else
            dict.Add key, data(i, 3)
        End If

    Next i

    ' 出力エリア初期化
    ws.Range("E:F").ClearContents
    ws.Range("E1:F1").Value = Array("商品", "売上合計")

    ' ===== 配列でまとめて出力（超高速）=====
    Dim result()
    ReDim result(1 To dict.Count, 1 To 2)

    Dim k As Variant
    Dim rowIndex As Long
    rowIndex = 1

    For Each k In dict.Keys
        result(rowIndex, 1) = k
        result(rowIndex, 2) = dict(k)
        rowIndex = rowIndex + 1
    Next k

    ws.Range("E2").Resize(dict.Count, 2).Value = result

    ' 設定を元に戻す
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

    MsgBox "最適化：" & (Timer - startTime) & " 秒"

End Sub

実測結果（100万行）

パターン	処理時間
Dictionaryなし	約250秒
Dictionaryあり	約12秒
最適化	約3.0秒

※上記結果は後述のテスト環境で測定

テスト環境

本記事の検証は以下の環境で実施しています。

OS：Windows 11
CPU：Intel Core i5
メモリ：16GB
Excel：Microsoft Excel 2016（32bit）

※環境によって多少変動します

なぜ速くなるのか？

Dictionaryなし：毎回検索（O(n²)）
Dictionaryあり：検索は速いがExcelアクセス多い
最適化：メモリ処理＋一括書き込み

まとめ

VBA高速化はこの3つだけ覚えればOKです。
➀ Excelアクセスを減らす
👉️ 配列で一括処理

② ループ回数を減らす
👉️ 検索はDictionary

③ 無駄な処理を止める
👉️ 画面更新OFF

おわりに

VBAは遅い言語ではありません。
正しく書けば、100万行でも数秒で処理できます。

実務VBAシリーズ