【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です！

実行結果

マイケル

このツールを実行した結果はこの通りです

マイケル

うまくCSV出力できていますね

エレキベア

空き容量すくな

マイケル

ちなみに今回はMacで実行しましたが、
Windowsで動かす場合にはパス名の記述を「/」から「¥」に変更して実行するようにしてください！

エレキベア

WindowsとMacだとパス名の記述が異なるクマね

マイケル

そうだね
それとMacの場合はパス名に日本語が含まれているとVBAでうまく読み込めないみたいだからそこも注意しよう！

エレキベア

VBAはWindowsのほうが動作環境としては良さそうクマ

おわりに

マイケル

さて今回は簡単なVBAツールを作りましたがいかがだったでしょうか？

エレキベア

これくらい知っとるわ！
と言う人も多かったのではないかと思われクマ

マイケル

冒頭でも話しましたが、データ読み込みとファイル出力は
仕事の効率化などで頻繁に活用できると思うのでぜひ習得してみてください！

マイケル

それではアデュー！

エレキベア

クマ〜〜〜〜〜

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

新装改訂版 Excel VBA 本格入門 ~マクロ記録・If文・ループによる日常...

￥3,278

Excel VBA 脱初心者のための集中講座

￥402