EXCELのVBAでADODBを使ってUTF8のファイルを読み書きするマクロを作る場合、ADODBの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秒ほどかかりました。

時間と処理件数のグラフは以下のようになっていました。後ろの行になるほど、１件当たりの処理時間が長くなっていきます。何故かは不明ですが、後ろの行ほどその行を取得するための時間が長くなっていくためと思われ、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