Excel VBA 逆引き集 | 100万行でも高速なループ

Excel VBA
スポンサーリンク

100万行でも高速なループ

「1,048,576行（Excelの最大行数）でも実用速度で処理したい」。鍵はセルへ個別アクセスを避けて、配列・可視セル集合・辞書・一括代入を組み合わせること。初心者でも迷わない最短テンプレと落とし穴回避をまとめます。

速度の基本原則

  • セル直アクセスを最小化: 配列に読み込み→配列で計算→一括書き戻しが圧倒的に速い。
  • 画面更新・再計算を一時停止: ScreenUpdating/Calculation/EnableEvents を OFF→ON で包む。
  • 範囲を絞る: CurrentRegionや最終行計算で「必要部分だけ」対象にする。
  • 条件集合で絞る: SpecialCells（可視・空白・数式・エラーなど）で対象を先に絞る。
  • 辞書で探索置換: ルックアップや重複判定は辞書（Scripting.Dictionary）が爆速。
  • 書式は後回し／最小限: 背景色やフォントはセル操作が重い。値の確定後に最小回数で適用。

最速テンプレ：配列一括処理（王道）

Sub MillionRows_ArrayBatch()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Dim rg As Range: Set rg = Range("A2:D1048576")  '必要範囲に絞る
    Dim v As Variant: v = rg.Value                   '2次元配列（1-based）

    Dim r As Long
    For r = 1 To UBound(v, 1)
        '例：数量=C(3) × 単価=D(4) → 金額=B(2)
        If IsNumeric(v(r, 3)) And IsNumeric(v(r, 4)) Then
            v(r, 2) = v(r, 3) * v(r, 4)
        Else
            v(r, 2) = ""  '欠損時は空
        End If
    Next r

    rg.Value = v                                     '一括書き戻し

Cleanup:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
VB
  • ポイント:
    • 配列→一括書き戻し: セル1個ずつより桁違いに速い。
    • EnableEvents: 変更イベントの暴発を防ぐ。
    • 対象範囲を適切に指定: 使う列だけに絞るとさらに速い。

バッチ分割：メモリ節約しながら高速（10万行ずつ）

Sub MillionRows_Chunked()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim last As Long: last = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Dim startRow As Long: startRow = 2
    Dim batchSize As Long: batchSize = 100000

    Dim r0 As Long, r1 As Long
    For r0 = startRow To last Step batchSize
        r1 = Application.Min(r0 + batchSize - 1, last)
        Dim rg As Range: Set rg = ws.Range("A" & r0 & ":D" & r1)
        Dim v As Variant: v = rg.Value

        Dim r As Long
        For r = 1 To UBound(v, 1)
            If IsNumeric(v(r, 3)) And IsNumeric(v(r, 4)) Then
                v(r, 2) = v(r, 3) * v(r, 4)
            Else
                v(r, 2) = ""
            End If
        Next r

        rg.Value = v
    Next r0

Cleanup:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
VB
  • ポイント:
    • 分割処理: メモリ負荷を抑え、安定して高速化。
    • Minで端切れ対応: 最終バッチは行数不足に備える。

可視セルだけ処理：フィルタ後に対象を絞る

Sub MillionRows_VisibleOnly()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim area As Range: Set area = Range("A1").CurrentRegion
    area.AutoFilter Field:=2, Criteria1:="営業A"

    Dim visKeys As Range
    On Error Resume Next
    Set visKeys = area.Offset(1).Resize(area.Rows.Count - 1).Columns(1).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Not visKeys Is Nothing Then
        Dim c As Range
        For Each c In visKeys
            Cells(c.Row, "H").Value = Cells(c.Row, "C").Value * Cells(c.Row, "D").Value
        Next c
    End If

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
VB
  • ポイント:
    • 重複回避: 行単位処理は「列1本に限定」して Row番号で横展開。
    • 0件エラー対策: SpecialCellsは該当なしでエラーになるためガード必須。

爆速ルックアップ：辞書でVLOOKUP代替

Sub MillionRows_FastLookup()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    'マスタ辞書（コード→単価）
    Dim price As Object: Set price = CreateObject("Scripting.Dictionary")
    Dim mLast As Long, r As Long
    mLast = Worksheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
    For r = 2 To mLast
        price(Worksheets("Master").Cells(r, "A").Value) = _
              Worksheets("Master").Cells(r, "B").Value
    Next

    '明細は配列で一括処理
    Dim rg As Range: Set rg = Range("C2:E1048576") 'C:コード D:数量 E:金額
    Dim v As Variant: v = rg.Value
    Dim i As Long, code As Variant, qty As Double

    For i = 1 To UBound(v, 1)
        code = v(i, 1)                        'C列
        qty = Val(v(i, 2))                    'D列
        If price.Exists(code) Then
            v(i, 3) = qty * price(code)       'E列に計算結果
        Else
            v(i, 3) = ""                       '未登録コード
        End If
    Next i

    rg.Value = v

Cleanup:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
VB
  • ポイント:
    • O(1)検索: 100万件でもルックアップが実用速度。
    • 配列×辞書: セル往復をなくして爆速化。

Evaluateで列演算（式を一括で渡す）

Sub MillionRows_Evaluate()
    Dim last As Long: last = Cells(Rows.Count, "C").End(xlUp).Row
    Range("E2:E" & last).Value = Evaluate("IF((C2:C" & last & ")*(D2:D" & last & ")>0,(C2:C" & last & ")*(D2:D" & last & "),"""")")
End Sub
VB
  • ポイント:
    • 列演算を一括: VBAループ不要で超高速。
    • 式の可読性と保守性: 複雑化しやすいので「定番の算式」に絞って使う。

実務向けフルテンプレ（安全ラップ＋ログ）

Sub MillionRows_FullTemplate()
    Dim t0 As Double: t0 = Timer

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    On Error GoTo Fail

    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim last As Long: last = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Dim rg As Range: Set rg = ws.Range("A2:D" & last)
    Dim v As Variant: v = rg.Value

    Dim r As Long
    For r = 1 To UBound(v, 1)
        If IsNumeric(v(r, 3)) And IsNumeric(v(r, 4)) Then
            v(r, 2) = v(r, 3) * v(r, 4)
        Else
            v(r, 2) = ""
        End If
    Next r

    rg.Value = v

    Dim t1 As Double: t1 = Timer
    Debug.Print "処理時間(秒): "; Format$(t1 - t0, "0.00")

Cleanup:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Exit Sub

Fail:
    Debug.Print "エラー: "; Err.Number; Err.Description
    Resume Cleanup
End Sub
VB
  • ポイント:
    • タイマーで計測: ボトルネックを見える化。
    • エラーハンドリング: 失敗時も各設定を復帰。

例題で練習

例題1：100万行の「空白行削除」を高速に

Sub Example_DeleteBlankRows_Fast()
    Application.ScreenUpdating = False
    Dim rg As Range: Set rg = Range("A1").CurrentRegion
    Dim blanks As Range
    On Error Resume Next
    Set blanks = rg.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If Not blanks Is Nothing Then blanks.EntireRow.Delete
    Application.ScreenUpdating = True
End Sub
VB

例題2：100万行の「数式列だけ値化」

Sub Example_FormulaToValues_Fast()
    Application.ScreenUpdating = False
    Dim f As Range
    On Error Resume Next
    Set f = Range("E2:E1048576").SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0
    If Not f Is Nothing Then f.Value = f.Value
    Application.ScreenUpdating = True
End Sub
VB

例題3：100万行でも「営業A」可視行だけ金額計算

Sub Example_VisibleOnly_Fast()
    Application.ScreenUpdating = False
    Dim area As Range: Set area = Range("A1").CurrentRegion
    area.AutoFilter Field:=2, Criteria1:="営業A"

    Dim vis As Range
    On Error Resume Next
    Set vis = area.Offset(1).Resize(area.Rows.Count - 1).Columns(1).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Not vis Is Nothing Then
        Dim c As Range
        For Each c In vis
            Cells(c.Row, "H").Value = Cells(c.Row, "C").Value * Cells(c.Row, "D").Value
        Next c
    End If
    Application.ScreenUpdating = True
End Sub
VB

落とし穴とチェックリスト

  • メモリ負荷:
    • チェック: 2次元配列が大きすぎると不安定。必要列のみ、バッチ分割で扱う。
  • 数式消失:
    • チェック: .Value = .Value は数式を値化する。必要なら事前退避（.Formulaの保存）。
  • イベント暴発:
    • チェック: EnableEvents を必ずOFF→ON。
  • 再計算の嵐:
    • チェック: Calculation を手動にしてから処理、最後に自動へ戻す。
  • CurrentRegionの途切れ:
    • チェック: 空行で切れる。最終行・最終列で明示範囲を組む。
  • 型混在:
    • チェック: IsNumeric/Val/CStr を適切に使う。
  • 重複処理:
    • チェック: 可視行は「列1本」＋Row展開で重複回避。
  • 書式の重さ:
    • チェック: 色付け・フォントは最小限に、値処理後にまとめて。
スポンサーリンク
タイトルとURLをコピーしました