複数のCSVを1つにまとめるVBAを作ってみた

1. 背景

　Excelで複数のCSVファイルを一つにまとめたいと思ったのですが、簡単にできそうな方法がなかったので、VBAでCSVを結合するツールを作ってみました。

2. ソースコード

　取り敢えず、下記のコードをコピペすれば動作するはずです。素人のコードですので、読みづらい点はご容赦ください。

Sub Main()
    Dim SelectedFiles As Variant '入力ファイル名の一覧
    Dim inputfile As String '入力ファイル名
    Dim OutputWB As Workbook '結合データ記入用ワークブック
    
    Set OutputWB = Workbooks.Add
    
    'エクスプローラーを起動し、ファイルを選択
    SelectedFiles = Application.GetOpenFilename("CSVファイル(*.csv),*.csv", MultiSelect:=True)
    
    'シートの枚数を確認
    Call CheckSheets(OutputWB)
    
    'CSVを読み込む
    Call ReadCSV(SelectedFiles, OutputWB)
End Sub

Private Sub CheckSheets(ByVal wb As Workbook)
    'シート数を二枚にする
    If wb.Worksheets.Count = 1 Then
        wb.Worksheets.Add
    End If
    'シート名称を変更
    wb.Worksheets(1).Name = "データ"
    wb.Worksheets(2).Name = "入力ファイル一覧"
End Sub

Private Sub ReadCSV(ByRef datafiles As Variant, ByVal wb As Workbook)
    Dim filecounter As Integer, arraycounter As Integer, rowcounter As Integer
    Dim buf As String
    Dim tmp As Variant, inputfile As Variant
    
    filecounter = 1
    rowcounter = 1
    For Each inputfile In datafiles
        wb.Worksheets(2).Cells(filecounter, 1).Value = inputfile
        Open inputfile For Input As #1
        If filecounter > 1 Then
            'ヘッダ分を読み込む
            Line Input #1, buf
        End If
        Do Until EOF(1)
            '一行分を読み込む
            Line Input #1, buf
            '区切り文字で分割する
            tmp = Split(buf, ",")
            For arraycounter = 1 To UBound(tmp)
                wb.Worksheets(1).Cells(rowcounter, arraycounter).Value = tmp(arraycounter)
            Next
            rowcounter = rowcounter + 1
        Loop
        Close #1
        filecounter = filecounter + 1
    Next inputfile
End Sub

2-1. メイン

　このツールの処理は次の通りです。結合したいCSVファイルをエクスプローラーで選択し、新規に開いたワークブックにデータと読み込んだファイルの一覧を記入するという処理をしています。

Sub Main()
    Dim SelectedFiles As Variant '入力ファイル名の一覧
    Dim inputfile As String '入力ファイル名
    Dim OutputWB As Workbook '結合データ記入用ワークブック
    
    Set OutputWB = Workbooks.Add
    
    'エクスプローラーを起動し、ファイルを選択
    SelectedFiles = Application.GetOpenFilename("CSVファイル(*.csv),*.csv", MultiSelect:=True)
    
    'シートの枚数を確認
    Call CheckSheets(OutputWB)
    
    'CSVを読み込む
    Call ReadCSV(SelectedFiles, OutputWB)
    
End Sub

2-2. シート枚数確認用の関数

　この関数では、シート枚数を確認し、1枚であればシートを追加する。その後、シート1, 2に名前をつけるという処理をしています。

Private Sub CheckSheets(ByVal wb As Workbook)
    'シート数を二枚にする
    If wb.Worksheets.Count = 1 Then
        wb.Worksheets.Add
    End If
    'シート名称を変更
    wb.Worksheets(1).Name = "データ"
    wb.Worksheets(2).Name = "入力ファイル一覧"
End Sub

2-3. データ書き込み用の関数

　この関数では、2-2. で2枚にしたワークブックにCSVのデータとファイルの一覧を記入する処理を行います。

Private Sub ReadCSV(ByRef datafiles As Variant, ByVal wb As Workbook)
    Dim filecounter As Integer, arraycounter As Integer, rowcounter As Integer
    Dim buf As String
    Dim tmp As Variant, inputfile As Variant
    
    filecounter = 1
    rowcounter = 1
    For Each inputfile In datafiles
        wb.Worksheets(2).Cells(filecounter, 1).Value = inputfile
        Open inputfile For Input As #1
        If filecounter > 1 Then
            'ヘッダ分を読み込む
            Line Input #1, buf
        End If
        Do Until EOF(1)
            '一行分を読み込む
            Line Input #1, buf
            '区切り文字で分割する
            tmp = Split(buf, ",")
            For arraycounter = 1 To UBound(tmp)
                wb.Worksheets(1).Cells(rowcounter, arraycounter).Value = tmp(arraycounter)
            Next
            rowcounter = rowcounter + 1
        Loop
        Close #1
        filecounter = filecounter + 1
    Next inputfile
End Sub