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