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

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

対象ファイルは、

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

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

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

というものです。

1.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

dxmax をいろいろ変更して実行してみた結果は、次のとおりです。

1000行一括処理:             113.8516  (秒)

10000行一括処理:            111.7891  (秒)

100000行一括処理:           111.6484  (秒)

400000行一括処理:           111.418  (秒)

メモリーに余裕があればできるだけ一括で処理する方がいいことだけは確かのようです。(当然といえば当然ですね‥)

2.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


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

10倍近く高速

に読み込めます。