エクセル2003　CSVファイルの取り込み速度向上について

Question

CSVファイルを取り込んで、必要なデーターを処理しているのですが、
CSVのファイルのデーター取り込み速度を上げるのを、皆様のご意見
を参考にさせていただきたいと思います。
VBAの構成は以下の構成でつくりました
(1)ファイルの選択
↓
(2)CSVファイルの中身の確認
↓
(3)CSVファイルの取り込み、エクセルのセルに展開
と言う構成になっております。
で、(3)の所が結構時間を要するのですが、処理が早くなるコードの
書き方とかありましたら、参考にさせていただきたいなぁ～と
思っております。自分的に思っているのは(2)の所は時間をそれほど
要しないので、取り込みよりエクセルのセル展開の処理の方で時間
をくっているように感じるので、その辺を上手くできないのかな？
とか思ったりしてます。まだ、VBAを勉強し始めて半年足らずなので
皆さんの意見などを参考にさせていただけましたと思っております。
宜しくお願いいたします。
実際のコードは以下に記します。




＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
Option Explicit
Option Base 1
    Dim myTxtFile As String
    Dim myBuf(45) As String
    Dim i As Integer, j As Integer
    Dim mytext As String, mymsg As String
    Dim myselect As Integer
    Dim FirstDay As String, EndDay As String
    Dim n As String
    
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿    
Private Sub ReadTxt()
    
    Application.ScreenUpdating = False
    n = 1
    Open myTxtFile For Input As #1
    Do Until EOF(1)
        Input #1, myBuf(1), myBuf(2), myBuf(3), myBuf(4), _
            myBuf(5), myBuf(6), myBuf(7), myBuf(8), myBuf(9), _
            myBuf(10), myBuf(11), myBuf(12), myBuf(13), myBuf(14), _
            myBuf(15), myBuf(16), myBuf(17), myBuf(18), myBuf(19), _
            myBuf(20), myBuf(21), myBuf(22), myBuf(23), myBuf(24), _
            myBuf(25), myBuf(26), myBuf(27), myBuf(28), myBuf(29), _
            myBuf(30), myBuf(31), myBuf(32), myBuf(33), myBuf(34), _
            myBuf(35), myBuf(36), myBuf(37), myBuf(38), myBuf(39), _
            myBuf(40), myBuf(41), myBuf(42), myBuf(43), myBuf(44), myBuf(45)
        If n = 2 Then
            FirstDay = myBuf(1)
        End If
        n = n + 1
        EndDay = myBuf(1)
    Loop
    EndDay = myBuf(1)
    
    mymsg = FirstDay & "～" & EndDay
    myselect = MsgBox(mymsg, vbYesNo + vbInformation)
    If myselect = vbNo Then
        Close #1
        Exit Sub
    End If
    Close #1
    Open myTxtFile For Input As #1
    Do Until EOF(1)
        Input #1, myBuf(1), myBuf(2), myBuf(3), myBuf(4), _
            myBuf(5), myBuf(6), myBuf(7), myBuf(8), myBuf(9), _
            myBuf(10), myBuf(11), myBuf(12), myBuf(13), myBuf(14), _
            myBuf(15), myBuf(16), myBuf(17), myBuf(18), myBuf(19), _
            myBuf(20), myBuf(21), myBuf(22), myBuf(23), myBuf(24), _
            myBuf(25), myBuf(26), myBuf(27), myBuf(28), myBuf(29), _
            myBuf(30), myBuf(31), myBuf(32), myBuf(33), myBuf(34), _
            myBuf(35), myBuf(36), myBuf(37), myBuf(38), myBuf(39), _
            myBuf(40), myBuf(41), myBuf(42), myBuf(43), myBuf(44), myBuf(45)
            
            'データをセルに展開する
        i = i + 1
        For j = 1 To 45
            Cells(i, j) = myBuf(j)
        Next j
    Loop
    
    Close #1
    Application.ScreenUpdating = True
End Sub

＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
Sub myOpenDialog()
    myTxtFile = Application.GetOpenFilename("CSV ファイル(*.csv),*.csv")
    Call ReadTxt
End Sub

hana-hana3 · Accepted Answer

Line Input #1, buf
で、一行読み込み。
ary = Split(buf, ",")
で、カンマ区切りデータを配列に一気に分割します。
Range("A" & i & ":AS" & i) = ary
で、該当セルに一括転記します。（for文より高速です）


Private Sub ReadTxt()
    
    Dim buf As String
    Dim ary As Variant
    
    Application.ScreenUpdating = False
    n = 1
    Open myTxtFile For Input As #1
    
    Do Until EOF(1)
        Line Input #1, buf
        ary = Split(buf, ",")
        If n = 2 Then FirstDay = ary(0)
        n = n + 1
        EndDay = ary(0)
    Loop
    mymsg = FirstDay & "～" & EndDay
    myselect = MsgBox(mymsg, vbYesNo + vbInformation)
    
    If myselect = vbNo Then
        Close #1
        Exit Sub
    End If
    
    Close #1
    
    Open myTxtFile For Input As #1
    
    i = 0
    Do Until EOF(1)
        i = i + 1
        Line Input #1, buf
        'データをセルに展開する
        ary = Split(buf, ",")
        Range("A" & i & ":AS" & i) = ary
    Loop
    
    Close #1
    Application.ScreenUpdating = True
End Sub

NNAQ · Answer

Option Explicit
Option Base 1

Sub myOpenDialog_ReadTxt()
'プロシージャをひとつにして、Loopを1度だけ回すようにしてみた

Const flds = 45 '列数
Dim myTxtFile As String
Dim myBuf() As String, buf As String
Dim i As Integer, j As Integer
Dim ary
Dim mytext As String, mymsg As String
Dim myselect As Integer
Dim FirstDay As String, EndDay As String

With Application
myTxtFile = .GetOpenFilename("CSV ファイル(*.csv),*.csv")

i = 0
Open myTxtFile For Input As #1
Do Until EOF(1)
    Line Input #1, buf
    ary = Split(buf, ",", flds)
    i = i + 1
    ReDim Preserve myBuf(flds, i) 'セルに展開するための2次元配列
    For j = 0 To UBound(ary)
        myBuf(j + 1, i) = ary(j)
    Next j
Loop
Close #1

FirstDay = myBuf(1, 2)
EndDay = myBuf(1, i)
mymsg = FirstDay & "～" & EndDay
myselect = MsgBox(mymsg, vbYesNo + vbInformation)
'データをセルに展開する（一括）
If myselect = vbYes Then
    .ScreenUpdating = False
    Cells(1).Resize(i, flds).Value = .WorksheetFunction.Transpose(myBuf)
End If
End With 'Application
Erase myBuf
End Sub

imogasi · Answer

（１）１つは既に回答に出ていますが
Split関数の利用
Arrayの値をを一括代入

（２）もうひとつは
データ
外部データの取り込み
ファイル種類ーCSV
・・
をマクロの記録をとって、必要な改変を行い、その方法の方が速いかどうかやってみる。
（３）A列にとりあえずCSVファイルのデータの各行（＝レコード）を読み込み、データー区切り位置ー・・の操作で列分割するとか（これも実際は人手操作でなく、マクロの記録を採って、そちらを使う）
など思いつきますが。

エクセル2003 CSVファイルの取り込み速度向上について

Line Input #1, buf

Option Explicit

（１）１つは既に回答に出ていますが

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

エクセル2003　CSVファイルの取り込み速度向上について