Sub InportCsv()
Dim fso As Object
Dim ts As Object
Dim ws As Worksheet
Dim tFilePath As String
Dim dataArray As Variant
Dim r As Integer, c As Integer
Dim eData As Variant
Dim fileName As Variant
fileName = False
Set ws = ThisWorkbook.Worksheets("データ")
ws.Cells.Clear
'ダイアログにてファイル取得
fileName = Application.GetOpenFilename("CSVファイル(*.csv),*.csv")
'取得できた場合
If fileName <> False Then
tFilePath = fileName
'取得不可の場合は終了
Else
MsgBox "ファイルを選択してください"
Exit Sub
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(tFilePath, 1)
'読込位置のカーソル移動(1行目を取得したくない場合)
' ts.SkipLine
r = 2
'シート「データ」に書き込み
With ws
'ファイルカーソルが末尾直前まで繰り返し
Do Until ts.AtEndOfStream
'1行ずつ読込、「,」で区切って配列格納
dataArray = Split(ts.ReadLine, ",")
'配列をセルに書き込み
c = 2
For Each eData In dataArray
.Cells(r, c).Value = eData
c = c + 1
Next eData
r = r + 1
Loop
'配列の初期化
Erase dataArray
End With
ts.Close
Set ts = Nothing
Set fso = Nothing
Set ws = Nothing
MsgBox "完了"
End Sub
コメント