これまでの処理はすべて1セルずつ行ってきました。5件の注文なら問題ありませんが、5万件では非常に遅くなります。この問題を解決するには、ワークシートをセルごとに操作するのではなく、範囲全体を一度にメモリ上の配列に取り込み、そこで処理を行い、最後にまとめて書き戻します。

配列への範囲の読み込み

Dim dataArr As Variant
dataArr = ws.Range("A2:I6").Value    ' one read, not 45 individual reads

dataArr はメモリ上の2次元配列になります。dataArr(1,1) は ORD1001、dataArr(1,4) は "Laptop Stand" などです。VBAで範囲から読み込んだ配列は0始まりではなく1始まりである点に注意が必要です。

配列の処理

通常のループで処理しますが、今度はメモリ上でループするため、ワークシート上でループするよりも何千倍も高速です。

Dim i As Long
Dim recalculated As Double
 
For i = 1 To UBound(dataArr, 1)
    recalculated = dataArr(i, 5) * dataArr(i, 6) * (1 - dataArr(i, 7))
    If Abs(recalculated - dataArr(i, 8)) > 0.01 Then
        Debug.Print "Mismatch on row " & i & ": sheet says " & dataArr(i, 8) & _
                    ", recalculated " & Format(recalculated, "0.00")
    End If
Next i

配列の書き戻し

これも一度の操作で行います。

ws.Range("A2:I6").Value = dataArr

Select と Activate の回避

記録されたマクロはこれら（Range("A1").Select の後に Selection.Font.Bold = True など）に大きく依存しますが、実際には不要で動作も遅くなります。すべての .Select は Excel の画面再描画を強制します。範囲やオブジェクトは直接参照してください：

' Avoid:
ws.Range("A1").Select
Selection.Font.Bold = True
 
' Prefer:
ws.Range("A1").Font.Bold = True

パフォーマンスの考慮点

データが数百行を超えると重要になります：

Application.ScreenUpdating = False   ' stop redrawing while the macro runs
Application.Calculation = xlCalculationManual   ' pause recalculation
Application.EnableEvents = False     ' suppress other macros triggering mid-run
 
' ... your fast array-based code here ...
 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

これらの設定は必ず最後に元に戻してください。復元処理はエラーハンドリングでラップし、途中でクラッシュしても画面更新がオフのままにならないようにします。

実例：注文整合性チェッカー

この章ではこれを目指してきました：

Option Explicit
 
Sub VerifyOrderTotals()
    Dim ws As Worksheet
    Dim dataArr As Variant
    Dim lastRow As Long
    Dim i As Long
    Dim recalculated As Double
    Dim issues As String
 
    Set ws = ThisWorkbook.Worksheets("Orders")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
 
    Application.ScreenUpdating = False
 
    dataArr = ws.Range("A2:I" & lastRow).Value
    issues = ""
 
    For i = 1 To UBound(dataArr, 1)
        recalculated = dataArr(i, 5) * dataArr(i, 6) * (1 - dataArr(i, 7))
        If Abs(recalculated - dataArr(i, 8)) > 0.01 Then
            issues = issues & dataArr(i, 1) & ": sheet=" & dataArr(i, 8) & _
                      ", expected=" & Format(recalculated, "0.00") & vbNewLine
        End If
    Next i
 
    Application.ScreenUpdating = True
 
    If issues = "" Then
        MsgBox "All " & UBound(dataArr, 1) & " order totals check out."
    Else
        MsgBox "Discrepancies found:" & vbNewLine & issues
    End If
End Sub

サンプルテーブルで実行すると、5件すべての合計が正しいと報告されます。シート上の ORD1002 の Total を不正な値に変更して再実行すると、警告が表示されることを確認してください。

課題

1. VerifyOrderTotals をワークブックにコピーし、5件のサンプル注文で実行してください。
2. シート上で1件の注文の Total を手動で不正な値に変更し（明らかに間違った数字を入力）、再実行して不一致が正しい Order ID で報告されることを確認してください。
3. 6行目の下に架空の注文データを10行追加し、コードを変更せずにマクロが正常に動作すること（lastRow と配列処理の効果）を確認してください。