【実務VBA③】100万行Excelを3秒で処理する方法（高速化完全ガイド）

Last updated at 2026-05-01Posted at 2026-03-24

はじめに

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シリーズ

You get articles that match your needs
You can efficiently read back useful information
You can use dark theme

What you can do with signing up