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

質問

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

回答No.1

hana-hana3 · ベストアンサー

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

お礼

ご返答ありがとうございます。
このようなやり方があるのですね。
勉強になります。
ありがとうございます

回答No.3

noname#262398

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

お礼

お返事ありがとうございます。
このように2次元配列で取得していくことも出来るのですね
ありがとうございます。
とても勉強になります。

回答No.2

imogasi

（１）１つは既に回答に出ていますが
Split関数の利用
Arrayの値をを一括代入

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

お礼

ご返答ありがとうございます。
その辺をちょっと色々試してみます。
ありがとうございます。