【VBA】データを複数のCSVファイルに出力するツールを作ってみた！

マイケル

ピースの角度は135度！
どうもマイケルです

エレキベア

パクったあげくどんなピースやねん

マイケル

今回はVBAツールを作ってみるよ！

マイケル

その名も・・・「データ複数CSVファイル出力くん」！

エレキベア

無理やりくっつけたクマね

マイケル

Excelに貼り付けたデータを複数のCSVファイルに出力する
という、ありがちかつ単純なツールだ！

エレキベア

なぜ今更そんな単純なツールを紹介するクマか

マイケル

Excelデータ読み書きとファイル出力はよく使われるし
応用が聞くからね！

マイケル

（まあほんとは
今月の目標記事数が全然足りて無い
からとにかくなんでも書いてるんだけど、黙っておこう）

エレキベア

何か言ったクマか？

マイケル

さ、さあ早速作っていこう！

仕様を考える
ツールの作成
実行結果
おわりに

仕様を考える

マイケル

ツールの仕様としてはこんな感じでいくよ！

マイケル

A列に出力するCSVのファイル名、B列以降に出力データを入力してCSV出力ボタン押下
すると、ツールと同フォルダに出力フォルダを作成して出力します！

エレキベア

簡単クマね

ツールの作成

マイケル

仕様を決めたらコードを書きます！
完成した全体のVBAコードはこちらになります！

Sub writeCSV()

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(1)

' 出力フォルダを作成
Dim outFolder As String
outFolder = ActiveWorkbook.Path & "/output_" & Format(Now, "yyyymmddHHMMSS")
MkDir outFolder

'---CSV出力処理---
Dim csvFile As String
Dim maxCol As Integer
Dim i As Long, j As Long
'★データ開始行：４
i = 4

'最大項目数の取得、CSVファイルをオープン
maxCol = Cells(i, Columns.Count).End(xlToLeft).Column
csvFile = outFolder & "/" & ws.Cells(i, 1).Value & ".csv"
Open csvFile For Output As #1

Do While ws.Cells(i, 1).Value <> ""
    '★データ開始列：2行目
    j = 2
    Do While j < maxCol
        Print #1, ws.Cells(i, j).Value & ",";
        j = j + 1
    Loop
    Print #1, ws.Cells(i, j).Value & vbCr;
    i = i + 1
    '次の行のファイル名と異なる場合出力
    If ws.Cells(i, 1).Value <> ws.Cells(i - 1, 1).Value Then
        Close #1
        '次のファイル名が入力されている場合
        '最大項目数の取得、CSVファイルをオープン
        If ws.Cells(i, 1).Value <> "" Then
            maxCol = Cells(i, Columns.Count).End(xlToLeft).Column
            csvFile = outFolder & "/" & ws.Cells(i, 1).Value & ".csv"
            Open csvFile For Output As #1
        End If
    End If
Loop
MsgBox outFolder & " に書き出しが完了しました！"
End Sub

マイケル

1. 出力フォルダを作成
2. データ数の取得・出力CSVファイルをオープン
3. 出力CSVファイルのデータ読み込み
4. 出力ファイル名が変わったらクローズ、他に出力するファイルがある場合、
　データ数を取得してCSVファイルをオープン

の手順になっています！

出力フォルダの作成

マイケル

冒頭の部分で出力するフォルダを作成しています！
今回は重複がないよう「output_yyyymmddHHMMSS」の名前にしています

' 出力フォルダを作成
Dim outFolder As String
outFolder = ActiveWorkbook.Path & "/output_" & Format(Now, "yyyymmddHHMMSS")
MkDir outFolder

データ数の取得・出力CSVファイルオープン

マイケル

そして最大項目数の取得と出力CSVファイルを作成してオープンします

マイケル

最大項目数取得の部分では、行の右端から「Ctrl + ⇦」で最後にデータがあるカラム列を調べています！

'最大項目数の取得、CSVファイルをオープン
maxCol = Cells(i, Columns.Count).End(xlToLeft).Column
csvFile = outFolder & "/" & ws.Cells(i, 1).Value & ".csv"
Open csvFile For Output As #1

データ読み込み

マイケル

そしてメイン部、データを読み込んでいきます！

マイケル

実際にデータがある行と列に合わせるため、
読み込み開始列と開始行はその分ずらしてあります！

Dim i As Long, j As Long
'★データ開始行：４
i = 4

・・・

Do While ws.Cells(i, 1).Value <> ""
    '★データ開始列：2行目
    j = 2
    Do While j < maxCol
        Print #1, ws.Cells(i, j).Value & ",";
        j = j + 1
    Loop
    Print #1, ws.Cells(i, j).Value & vbCr;
    i = i + 1
    ・・・
        End If
    End If
Loop

出力ファイルのクローズと次の出力ファイルのオープン

マイケル

読み込んだファイル名が次の行のファイル名と異なる場合、
読み込んだファイルをクローズします！

マイケル

そして次のファイル名が設定されている場合、
また最大項目数を取得してCSVファイルをオープンします

Do While ws.Cells(i, 1).Value <> ""
    ・・・
    '次の行のファイル名と異なる場合出力
    If ws.Cells(i, 1).Value <> ws.Cells(i - 1, 1).Value Then
        Close #1
        '次のファイル名が入力されている場合
        '最大項目数の取得、CSVファイルをオープン
        If ws.Cells(i, 1).Value <> "" Then
            maxCol = Cells(i, Columns.Count).End(xlToLeft).Column
            csvFile = outFolder & "/" & ws.Cells(i, 1).Value & ".csv"
            Open csvFile For Output As #1
        End If
    End If
Loop

マイケル

今回は読み込むファイル内の項目数は全て同じとして
ファイル作成毎に項目数を取得しているけど、データごとに異なる場合は
ループ毎に最大項目数を取得し直せばOKです！