【Excel】VBAでセルの書き込みを５倍高速化する方法

Excel VBAで While文やFOR文を使用してループさせ、行、列をカウントアップして、
大量のデータをセルに直接書き込む。

この「直接書き込む」を「レコードセット」で書き込むことで、
約５倍速くなったので、検証結果とサンプルコード。

検証した環境

検証内容

Excelのセルに「直接書込み」と「レコードセット書込み」を行い、

横(列)を26列(Ａ列~Ｚ列)、縦(行)を10000~100000行にデータを書き込み、

時間を比較する。

検証結果

・検証結果の表

小数点以下を省略しているため、10000行の時は約4倍程度だが、

100000行の時は、５倍以上の速度差が出ている。

・検証結果のグラフ

レコードセットを使って書き込んだ場合、約５倍以上、高速で処理できる。

当然、環境にも左右されるが、セルに大量に書き込みを行う場合、レコードセットを使用して書き込んだ方が圧倒的に効率が良い。

検証に使用したサンプルVBA

レコードセットを使ったデータ書込み

'######################################################
'
' レコードセットを使ったデータの書き込み
'
'   ※参照設定で「Microsoft ActiveX Data Objects 6.1 Library」にチェック
'######################################################
Sub レコードセットを使ったエクセル書き込み()

    '--------------------------------------------------
    ' 変数定義
    '--------------------------------------------------
    Dim ColCnt As Long                      '列カウント用
    Dim RowCnt As Long                      '行カウント用
    Dim i As Long                           'レコードセット作成ループカウント
    Dim StartTime As String                 '開始時間取得

    '--------------------------------------------------
    ' 時間測定開始
    '--------------------------------------------------
    StartTime = Time
    '--------------------------------------------------
    ' スクリーンアップデート OFF
    '--------------------------------------------------
    Application.ScreenUpdating = False
    '--------------------------------------------------
    ' レコードセットの作成
    '--------------------------------------------------
    'レコードセット定義
    Dim Res As ADODB.Recordset          'エクセル書き込み用レコードセット
    'セット
    Set Res = New ADODB.Recordset
    
    'カラムを26個(エクセルシートのA～Z列)を追加
    For i = 1 To 26
        Res.Fields.Append i, adInteger
    Next
    'レコードセットオープン
    Res.Open

    '--------------------------------------------------
    ' 横:26(A～Z)、縦:100000にデータを入力するループ
    '--------------------------------------------------

    '初期値設定
    ColCnt = 1
    RowCnt = 1
    
    '行が100000を超えるまでループ
    Do While RowCnt <= 100000
        Res.AddNew
        '列が26(A～Z)までループ
        Do While ColCnt <= 26
            '--------------------------------------------------
            '本来直接シートに書き込むところをレコードセットへ格納
            '--------------------------------------------------
            Res(ColCnt - 1) = RowCnt & ColCnt
            'Cells(RowCnt, ColCnt).Value = RowCnt & ColCnt
    
            ColCnt = ColCnt + 1
        Loop
    
        '次のレコードへ移動
        Res.MoveNext
        '列カウントのリセット
        ColCnt = 1
        '行のカウントアップ
        RowCnt = RowCnt + 1
    Loop

    '--------------------------------------------------
    ' レコードセットをシートに貼り付け
    '--------------------------------------------------
    'レコードセット先頭へ
    Res.MoveFirst
    
    '貼り付け
    Range("A1").CopyFromRecordset Res

    'レコードセットのクローズ
    Res.Close
    Set Res = Nothing

    '--------------------------------------------------
    ' スクリーンアップデート ON
    '--------------------------------------------------
    Application.ScreenUpdating = True
    '--------------------------------------------------
    ' 終了時間とメッセージ表示
    '--------------------------------------------------
    MsgBox "開始時間:" & StartTime & vbCrLf & _
           "終了時間:" & Time


End Sub

セルに直接データ書込み

'######################################################
'
' セルへ値の直接書き込み
'
'######################################################
Sub エクセル書き込み()

    '--------------------------------------------------
    ' 変数定義
    '--------------------------------------------------
    Dim ColCnt As Long                      '列カウント用
    Dim RowCnt As Long                      '行カウント用
    Dim StartTime As String                 '開始時間取得

    '--------------------------------------------------
    ' 時間測定開始
    '--------------------------------------------------
    StartTime = Time
    '--------------------------------------------------
    ' スクリーンアップデート OFF
    '--------------------------------------------------
    Application.ScreenUpdating = False
    '--------------------------------------------------
    ' 横:26(A～Z)、縦:100000にデータを入力するループ
    '--------------------------------------------------

    '初期値設定
    ColCnt = 1
    RowCnt = 1
    
    '行が100000を超えるまでループ
    Do While RowCnt <= 100000
    
        '列が26(A～Z)を超えるまでループ
        Do While ColCnt <= 26
            Cells(RowCnt, ColCnt).Value = RowCnt & ColCnt
            ColCnt = ColCnt + 1
        Loop
    
        '列カウントのリセット
        ColCnt = 1
        '行のカウントアップ
        RowCnt = RowCnt + 1
    Loop

    '--------------------------------------------------
    ' スクリーンアップデート ON
    '--------------------------------------------------
    Application.ScreenUpdating = True
    '--------------------------------------------------
    ' 終了時間とメッセージ表示
    '--------------------------------------------------
    MsgBox "開始時間:" & StartTime & vbCrLf & _
           "終了時間:" & Time


End Sub