VBAでADODBの1行読み込みが遅い時の対処法


EXCELのVBAでUTF8のファイルを読み書きするマクロを作る場合はADODBを使うと思いますが、ADODBの1行読み込みを行数の多いファイルに対してループ処理すると、処理がかなり遅くなったのでその時の対処法を紹介します。

単純な1行読み込みのコードと処理速度

ADODBを使ってファイルを1行ずつ読み込むコードは以下のようになります。以下のコードでは、ファイルを1行読み込み別のファイルに書き込む処理を行数分ループ処理しています。

Dim csvIn, csvOut As ADODB.Stream

Set csvIn = CreateObject("ADODB.Stream")
Set csvOut = CreateObject("ADODB.Stream")

With csvIn
    .Charset = "UTF-8"
    .LineSeparator = adCRLF
    .Open
    .LoadFromFile "csvIn.csv"
End With

With csvOut
    .Charset = "UTF-8"
    .LineSeparator = adCRLF
    .Open
End With

Do Until csvIn.EOS
    strLine = csvIn.ReadText(adReadLine)
    csvOut.WriteText strLine, adWriteChar
Loop

csvOut.SaveToFile "csvOut.csv", adSaveCreateOverWrite

csvIn.Close
csvOut.Close

実際に50万行(70MB)のファイルを上記コードで処理してみたところ、50秒ほどかかりました。

時間と処理件数のグラフは以下のようになっていました。後ろの行になるほど、1件当たりの処理時間が長くなっていきます。何故かは不明ですが、後ろの行ほどその行を取得するための時間が長くなっていくためと思われ、100万行を超えてくると数十分、数時間必要となり使い物にならなくなってきます。

一定サイズごとにファイルを読み込む

一定サイズごとにファイルを読み込むように処理を変更することで、高速化を行うことができます。サンプルコードは以下のようになります。以下の例では2048文字を取得するループを繰り返し1行ごとの処理を実装しています。

行ごとにループしていないため、改行コードで文字列を分割するなどの処理が必要ですが、こうすることで、先と同じファイルを6秒(約10倍の速さ )で処理することができました。また、処理時間も線形となり、後ろの行でも処理時間は一定となっています。

Dim csvIn, csvOut As ADODB.Stream

Set csvIn = CreateObject("ADODB.Stream")
Set csvOut = CreateObject("ADODB.Stream")

With csvIn
    .Charset = "UTF-8"
    .LineSeparator = adCRLF
    .Open
    .LoadFromFile "csvIn.csv"
End With

With csvOut
    .Charset = "UTF-8"
    .LineSeparator = adCRLF
    .Open
End With

Dim lines As Variant
Dim lastLine As String

Do Until csvIn.EOS
    strBulk = csvIn.ReadText(2048) '2048文字毎に読み込み
    lines = Split(strBulk, vbLF) 'CRLFで区切ると、2048文字でCRとLFが分断された時に区切れない
    
    Dim lineCnt As Integer
    lineCnt = UBound(lines)
    
    ' 前回ループの最終行を今回ループの最初の行と結合する
    lines(0) = lastLine + lines(0) 
            
    For i = 0 To (lineCnt - 1)
        Replace(lines(i), vbCR, "") 'LFで区切っているためCRは削除
        csvOut.WriteText lines(i), adWriteLine
    Next
    
    lastLine = lines(lineCnt)'最終行は次ループへ持ち越し
Loop

csvOut.WriteText lastLine, adWriteLine '最終行の処理

csvOut.SaveToFile "csvOut.csv", adSaveCreateOverWrite

csvIn.Close
csvOut.Close

一括でファイルを読み込む場合

参考までにですが、ファイルを一括で読み込み改行コードで区切る処理に変更して時間を計測しようとしましたが、この場合いくら待っても処理が終わらないぐらい遅くなってしましました。サンプルコードは以下となります。

Dim csvIn, csvOut As ADODB.Stream

Set csvIn = CreateObject("ADODB.Stream")
Set csvOut = CreateObject("ADODB.Stream")

With csvIn
    .Charset = "UTF-8"
    .LineSeparator = adCRLF
    .Open
    .LoadFromFile "csvIn.csv"
End With

With csvOut
    .Charset = "UTF-8"
    .LineSeparator = adCRLF
    .Open
End With

Dim lines As Variant

Do Until csvIn.EOS
    strAll = csvIn.ReadText(adReadAll) '2048文字毎に読み込み
    lines = Split(strAll, vbCRLF) 
    
    Dim lineCnt As Integer
    lineCnt = UBound(lines)
    
    For i = 0 To lineCnt
        csvOut.WriteText lines(i), adWriteLine
    Next
    
Loop

csvOut.SaveToFile "csvOut.csv", adSaveCreateOverWrite

csvIn.Close
csvOut.Close

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です