テキストファイル読込速度比較

2012年1月06日

CSVファイルの読み込みについて、いくつか記事を投稿していますが、VBAプログラムで読み込んだ場合とExcelのメニュから読み込んだ場合(もちろんマクロ化していますが）の速度比較をして見ました。

CPUやHDDの読込速度その他の影響がありますので、これをもって結論とするわけではありませんが、ひとつの実験結果として参考にしてください。

対象ファイルは、

ファイルサイズ：　23,177,231 バイト

レコード数：　　　　381,053レコード

1レコードあたりのサイズは、約60バイト/レコード

というものです。

１．VBAプログラムで読み込んだ場合

プログラムは次のとおりです。 

Option Explicit

Public Const SEPACHR As Variant = ","

Public tm As Variant
Public Function SplitByComma(strbuf As Variant) As Variant
    '‥,"文字列",数値,‥ のように、各データが、
    '文字列は["]で囲まれ、数値はそのままの形で[.]により
    '区切られているCSVファイルで、
    '文字列の中に[,]を含んでいるかもしれないとき、
    '各データを配列に入れて返す
    
    Dim buf As Variant
    
    Dim idx As Long
    Dim tmp As Variant
    Dim pos As Long
    Dim strnum As Long
    
    strnum = Len(strbuf)
    idx = 1
    buf = ""
    Do Until idx > strnum
        tmp = Mid(strbuf, idx, 1)
        If tmp = Chr(34) Then '
            '先頭が　"　だったら、次の　",　を探す
            pos = InStr(idx, strbuf, Chr(34) & SEPACHR, vbTextCompare) ' ",
            If pos > 0 Then
                '見つかったら、その前までをとり出す
'2011/12/09-----
                If pos = idx Then 'sepachrが先頭にある
                    '次の　",　を探す
                    pos = InStr(idx + 1, strbuf, Chr(34) & SEPACHR, vbTextCompare) ' ",
                    If pos > 0 Then
                        tmp = Mid(strbuf, idx + 1, pos - 1 - idx)
                        idx = pos + Len(Chr(34) & SEPACHR)
                    Else
                        '見つからなかったら最後のひとつ前までを取り出す
                        '　←　最後は　"　のはずなので
                        tmp = Mid(strbuf, idx + 1, Len(strbuf) - idx - 1)
                        idx = Len(strbuf) + 1
                    End If
'-----2011/12/09
                Else
                    tmp = Mid(strbuf, idx + 1, pos - 1 - idx)
                    idx = pos + Len(Chr(34) & SEPACHR)
                End If
            Else
                '見つからなかったら最後のひとつ前までを取り出す
                '　←　最後は　"　のはずなので
                tmp = Mid(strbuf, idx + 1, Len(strbuf) - idx - 1)
                idx = Len(strbuf) + 1
            End If
        Else
            pos = InStr(idx, strbuf, SEPACHR, vbTextCompare) ' ",
            If pos > 0 Then
                '見つかったら、その前までをとり出す
                tmp = Mid(strbuf, idx, pos - idx)
                idx = pos + Len(SEPACHR)
            Else
                '見つからなかったら最後までを取り出す
                tmp = Mid(strbuf, idx)
                idx = Len(strbuf) + 1
            End If
        End If
        buf = buf & tmp & vbTab '出力用文字列に格納。タブで連結する。
        
            '普通は手入力時に文字としてtabは使わないですが、
            'たとえば、
            'Excelシートで、1行をコピーし、テキストエディタの画面に貼り付けると、
            'セルのデータがタブで区切られて貼りつけられます。
            'こんなデータには、適用不可です。
            
        DoEvents
    Loop
 
    '配列に入れて返す
    SplitByComma = Split(Left(buf, Len(buf) - 1), vbTab, , vbTextCompare)
 
End Function
 
 
 
Public Sub getTextFile()
    'テキストファイルから読み込み、シートに表示する
    
    Dim strpath As Variant
    Dim buf As Variant
    Dim tmp As Variant
    Const idxmax As Long = 1000 '一度に処理するレコード数
    Dim idx As Long
    Dim fn As Integer
    Dim rr As Long
    Dim cc As Long
    Dim aryOut As Variant
    Dim numItem As Long
    Dim cntr As Long
    
    
    
    strpath = Application.GetOpenFilename( _
        FileFilter:="Textファイル (*.txt), *.txt,CSVファイル (*.csv), *.csv", _
        Title:="読込みたいテキストファイル（カンマ区切り）を選択してください", _
        MultiSelect:=False)
    If strpath = False Then
        Exit Sub
    End If
 
    With ActiveWorkbook.Worksheets("work").Cells
        .Clear
        .NumberFormatLocal = "@"
    End With
        
tm = Timer()
 
    ReDim buf(0 To idxmax - 1)
 
    fn = FreeFile
    Open strpath For Input As #fn
    
    '先頭行＝項目名　とする
    Line Input #fn, buf(0)
    tmp = SplitByComma(buf(idx))
    numItem = UBound(tmp) + 1
    
    cntr = 0
    Do Until EOF(fn)
        idx = 0
        ReDim buf(0 To idxmax - 1)
        
        Do While idx < idxmax And Not EOF(fn)
            'idxmax行のレコードを一括処理する
            Line Input #fn, buf(idx)
 
            DoEvents
            idx = idx + 1
        Loop
        ReDim Preserve buf(0 To idx - 1)
        ReDim aryOut(0 To UBound(buf), 0 To numItem + 1)
        
        For rr = 0 To idx - 1
            tmp = SplitByComma(buf(rr))
            For cc = 0 To UBound(tmp)
                aryOut(rr, cc) = tmp(cc)
            Next cc
        Next rr
        
        With ActiveWorkbook.Worksheets("work")
            .Range(.Cells(cntr * idxmax + 1, 1), _
                    .Cells(cntr * idxmax + 1 + UBound(aryOut, 1), UBound(aryOut, 2) + 1)) _
            = aryOut
        End With
        
        DoEvents
        cntr = cntr + 1
    
    Loop
    
    Close #fn
    
Debug.Print idxmax & "行一括処理：", Timer() - tm
 
End Sub
 
 
idxmax をいろいろ変更して実行してみた結果は、次のとおりです。
1000行一括処理：             113.8516 　(秒)
10000行一括処理：            111.7891 　(秒)
100000行一括処理：           111.6484 　(秒)
400000行一括処理：           111.418 　(秒)
 
メモリーに余裕があればできるだけ一括で処理する方がいいことだけは確かのようです。（当然といえば当然ですね‥）
 
 

２．Excelのメニュから実行した場合

CSVファイルを読みこむ(Excel）に記載しているように、ファイルメニュから読み込むと更に高速に読み込めます。

プログラムは下記のとおりです。

Public Sub getTextFileByExcel()

    'Excel機能によりテキストファイルから読み込み、シートに表示する

    Dim strpath As Variant

 

    strpath = Application.GetOpenFilename( _

        FileFilter:="Textファイル (*.txt), *.txt,CSVファイル (*.csv), *.csv", _

        Title:="読込みたいテキストファイル（カンマ区切り）を選択してください", _

        MultiSelect:=False)

    If strpath = False Then

        Exit Sub

    End If

    

tm = Timer()

    Workbooks.OpenText filename:=strpath, _

        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _

        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _

        Comma:=True, Space:=False, Other:=False, _

        TrailingMinusNumbers:=True

 

Debug.Print "Excelメニュから読み込み：", Timer() - tm

End Sub

 
実行結果は、
 
Excelメニュから読み込み：    12.93359 (秒)

です。

 

３．Excelのメニュから読み込んだほうが、VBAプログラムから読み込んだ場合より

10倍近く高速

に読み込めます。