CSVファイルを毎回エクセルに取り込んでから作業するのは非効率なので、CVSファイルを配列に格納してからマクロ処理をする場合の事例を紹介します。
今回の事例はCSVファイルが格納されているフォルダを指定し、そのフォルダ内に存在するCSVファイルのデータを配列格納するマクロです。
Sub 複数のcsvファイルデータを配列に格納する()
Dim folder_Path As String
Dim fso As Object
Dim filePath As String
Dim file As Object
Dim CSV_HAIRETSU()
Dim retsumei() As String
Dim data As Variant
Dim line As String
Dim i, j As Integer
'配列を二次元で再定義(行数は1000で固定)
ReDim CSV_HAIRETSU(1000, 1000) As Variant
'フォルダダイアログを開いてデータを取り込むcsvファイルが格納されているフォルダを選択する
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Title = "フォルダを選択してください"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
folder_Path = .SelectedItems(1)
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folder_Path)
i = 1
'選択したフォルダ内の全てのファイルに対して処理を行う
For Each file In folder.Files
'ファイルの拡張子が.csvの場合に限りファイルを開く
If Right(file.Name, 4) = ".csv" Then
Set file = fso.OpenTextFile(file.path)
'列名を取得する(1行目(i=1)を列名とする)
retsumei = Split(file.ReadLine, ",")
'列名を配列へ格納する(CSVファイル2つ目以降は列名無視)
If i = 1 Then
For j = LBound(retsumei) To UBound(retsumei)
CSV_HAIRETSU(i - 1, j) = retsumei(j)
Next j
Else
End If
'CSVファイルのデータを配列へ格納する(列名は無視)
Do Until file.AtEndOfStream 'csvファイルの2行目~最終行目まで繰り返し
line = file.ReadLine
data = Split(line, ",")
For j = LBound(data) To UBound(data)
CSV_HAIRETSU(i, j) = data(j)
Next j
i = i + 1
Loop
'csvファイルを閉じる
file.Close
End If
Next file
'列名の数に配列を縮小再定義する(行数は1000で固定)
ReDim Preserve CSV_HAIRETSU(1000, 0 To UBound(retsumei))
End Sub
コメント