n個のCSVをユーザーが任意に選択して、”まとめシート”にまとめる

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

Leave a Reply

Your email address will not be published. Required fields are marked *