【VBA】複数のCSVファイルをシート別にまとめる

今回はVBAで複数のCSVファイルをシート別に取り込む方法を紹介します。

このVBAでやりたいこと

複数のCSVファイルを読み込む
読み込んだCSVファイルはシート別に分ける

created by Rinker

マイナビ出版

30日間無料登録できる「Amazonプライム会員」に登録すれば、翌日に購入した商品が届くお急ぎ便・お届け日時指定便の指定ができるので、荷物をなるべく早く受け取りたい人にオススメ！

無料体験期間中もAmazonプライムビデオや1億曲以上聞き放題のAmazon Musicなど、すべてのプライム会員特典がセットになっています！

　　30日間の無料体験はこちら！　　

うめ

30日間以内に解約すれば費用は発生しません！

準備編
コード
実行結果

準備編

動作環境用に同じ構成のCSVファイル複数を用意。

・Cドライブ直下作成した「smaple」フォルダにデータを入れていきます。

名前データは「テストデータ・ジェネレータ」をお借りしました。

・「設定」シートを作成して「C2セル」にテストデータ格納先を指定

準備はここまで。

コード

Sub Csv_Import()

'--------------------------------------------------------
' 設定シートの取込データ(C2)に指定されたcsvファイルを読込
'--------------------------------------------------------

Dim Line_Str As String   '1行読み込み用のバッファ
Dim Array_Str As Variant '1行データを格納する配列
Dim Row_Index As Integer '出力する開始行
Dim Imp_Pass As String: Imp_Pass = Worksheets(1).Range("C2") '取込パス
Dim Imp_File As String: Imp_File = Dir(Imp_Pass & "\" & "*.csv") 'csv読込用
Dim ObjFileSys As Object
Dim File_Name As String  'シート名設定用
Dim targetSheet     As Worksheet    '繰り返し用
 
'「設定」以外のシートが存在する場合は削除
For Each targetSheet In Worksheets

    Select Case targetSheet.Name
        Case "設定"
            '削除対象外なので、処理はなし
        
        Case Else
            '指定したシート以外なので削除
            targetSheet.Delete
    End Select
    
Next

'ファイルが存在する限り処理を継続
Do Until Imp_File = ""
    
    'ワークシートの最後(右側)に追加
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    
    'ファイルシステムを扱うオブジェクトを作成
    Set ObjFileSys = CreateObject("Scripting.FileSystemObject")
    
    '拡張子なしのファイル名を取得
    File_Name = ObjFileSys.GetBaseName(Imp_File)
    
    'シート名変更
    ActiveSheet.Name = File_Name
    
    'csvファイルをオープン
    Open Imp_Pass & "\" & Imp_File For Input As #1
    
    '出力開始位置
    Row_Index = 0
    
    'CSVファイルを最後まで読み込み
    Do While Not EOF(1)
    
        'CSVファイルを1行ずつ読み込み
        Line Input #1, Line_Str
        
        'カンマ区切りで配列に格納
        Array_Str = Split(Line_Str, ",")
        
        'A1セルベースに位置を調整
        Range("A1").Resize(1, UBound(Array_Str) + 1).Offset(Row_Index) = Array_Str
        
        '出力位置の調整
        Row_Index = Row_Index + 1
    
    Loop
    
    'CSVファイルを閉じる
    Close #1
    
    '次のファイルを読込
    Imp_File = Dir()

Loop

End Sub

Sub Csv_Import()

'--------------------------------------------------------

' 設定シートの取込データ(C2)に指定されたcsvファイルを読込

'--------------------------------------------------------

Dim Line_Str As String '1行読み込み用のバッファ

Dim Array_Str As Variant '1行データを格納する配列

Dim Row_Index As Integer '出力する開始行

Dim Imp_Pass As String: Imp_Pass = Worksheets(1).Range("C2") '取込パス

Dim Imp_File As String: Imp_File = Dir(Imp_Pass & "\" & "*.csv") 'csv読込用

Dim ObjFileSys As Object

Dim File_Name As String 'シート名設定用

Dim targetSheet As Worksheet '繰り返し用

'「設定」以外のシートが存在する場合は削除

For Each targetSheet In Worksheets

Select Case targetSheet.Name

Case "設定"

'削除対象外なので、処理はなし

Case Else

'指定したシート以外なので削除

targetSheet.Delete

End Select

'ファイルが存在する限り処理を継続

Do Until Imp_File = ""

'ワークシートの最後(右側)に追加

Worksheets.Add After:=Worksheets(Worksheets.Count)

'ファイルシステムを扱うオブジェクトを作成

Set ObjFileSys = CreateObject("Scripting.FileSystemObject")

'拡張子なしのファイル名を取得

File_Name = ObjFileSys.GetBaseName(Imp_File)

'シート名変更

ActiveSheet.Name = File_Name

'csvファイルをオープン

Open Imp_Pass & "\" & Imp_File For Input As #1

'出力開始位置

Row_Index = 0

'CSVファイルを最後まで読み込み

Do While Not EOF(1)

'CSVファイルを1行ずつ読み込み

Line Input #1, Line_Str

'カンマ区切りで配列に格納

Array_Str = Split(Line_Str, ",")

'A1セルベースに位置を調整

Range("A1").Resize(1, UBound(Array_Str) + 1).Offset(Row_Index) = Array_Str

'出力位置の調整

Row_Index = Row_Index + 1

Loop

'CSVファイルを閉じる

Close #1

'次のファイルを読込

Imp_File = Dir()

Loop

End Sub

実行結果

VBAを実行すると取込データに指定したパスに格納されているCSVファイルが空になるまでシート別に読み込むことができます。

うめ

サンプル１～４までが読み込まれていることがわかりますね！