Option Explicit
Sub MatomeMultiCSVs()
'n個のCSVをユーザーが任意に選択して、”まとめシート”にまとめるプログラム
'個々のCSVは同じ配列(カラム数)をしているものとする
'(実際は、カラム数が違っていても読めてしまいますが)
'個々のCSVの1行目はヘッダであるものとする
Dim MatomeSheet As Worksheet
Set MatomeSheet = ThisWorkbook.Worksheets("まとめシート")
Dim SavingFileName As Variant 'まとめシートをCSVで保存するときのファイル名
'開くCSV群。複数あり。
Dim myCSVs As Variant
Dim I As Long '配列のインデックス番号
Dim f As Long '開くCSV群の数
Dim Header As String 'ヘッダ行を読むけど捨てるためだけに使っています
Dim r As Long 'レポートシートの行番号です
'一個のCSVの1行ぶんの文字列です
Dim strCSV As String
'一個のCSVの1行ぶんを、配列に格納するためのものです
Dim ArrCSV As Variant
Dim FileCount As Long '処理したファイルの数
Dim LineCount As Long '処理した行数
FileCount = 0 'ファイル数カウンタをリセット
LineCount = 0 '行数カウンタをリセット
'まとめシートを念のためクリアしておく
MatomeSheet.Cells.EntireColumn.Clear
'CSVを開きます
myCSVs = Application.GetOpenFilename( _
fileFilter:="CSVファイル,*.csv", _
Title:="読み込むCSVを選択してください. 複数選択が可能です.", _
MultiSelect:=True)
'キャンセルボタンを押された場合の処理
If IsArray(myCSVs) = False Then
MsgBox "キャンセルされました"
Exit Sub
End If
r = 1 'まとめシートの1行目からスタート
For f = 1 To UBound(myCSVs)
'CSVファイルを開きます
Open myCSVs(f) For Input As #1
FileCount = FileCount + 1
'2番目のCSV以降は、1行目(ヘッダ)は読み込むが使わない
If f > 1 Then
Line Input #1, Header
End If
Do Until EOF(1)
Line Input #1, myCSVs(f)
'CSVの一行分を、配列に格納します
ArrCSV = Split(myCSVs(f), ",")
For I = 0 To UBound(ArrCSV)
MatomeSheet.Cells(r, I + 1) = ArrCSV(I)
Next I
'ここで行送りします
r = r + 1
LineCount = LineCount + 1
'CSVファイルの次の行へシフトします
Loop
'CSVファイルを閉じます
Close #1
Next f
'まとめシートをアクティベートします
MatomeSheet.Activate
MsgBox "処理が完了しました" & vbNewLine & _
"処理したCSVのファイル数 = " & FileCount & vbNewLine & _
"処理した行数 = " & LineCount
'まとめシートをCSVで保存する
SavingFileName = Application.GetSaveAsFilename(InitialFileName:="まとめ.csv", _
fileFilter:="CSVファイル,*.csv", _
Title:="まとめCSVの保存先を指定してください")
'キャンセルボタンを押された場合の処理
If SavingFileName = False Then
MsgBox "キャンセルされました"
Exit Sub
End If
MatomeSheet.SaveAs SavingFileName, FileFormat:=xlCSV
MsgBox "保存しました"
End Sub