🔄
ExportToCSV
データ処理アクティブシートをCSVファイルとしてエクスポートします
アクティブシートのデータをCSVファイルとして指定したパスに書き出すマクロです。Excelの「名前を付けて保存」でCSVを選ぶ場合と異なり、元のExcelファイルを維持したままCSVだけを出力できます。書き出し先のフォルダとファイル名はダイアログで指定可能で、既存ファイルへの上書き確認も行います。システム間のデータ連携・定期的なデータエクスポート業務の自動化に役立ちます。文字コードはUTF-8で出力されます。出力処理はシートのコピーを別ブックとして保存する方式のため、元ブックのシート構成やレイアウトには一切影響しません。「名前を付けて保存」でCSVを選ぶと元ファイル自体がCSVに変わってしまい数式や書式が失われる事故が起きがちですが、このマクロならその心配がありません。日次・週次のデータ連携など、決まったシートを決まった形式で出す業務はこのマクロでルーチン化するのが確実です。
📖 使い方
- VBAエディタを開く（Alt + F11）
- モジュールを挿入（挿入 > モジュール）
- 下記VBAコードをコピー&ペースト
- ブック上で実行（Alt + F8 でマクロ選択）
💡 実行例： ExportToCSV を実行すると、現在のシートがCSV形式で保存されます
🎯 活用シーン
- ✓在庫管理システムや販売管理システムへのデータインポート用にExcelデータをCSV形式で定期出力したいとき
- ✓Webサービスやデータベースへのアップロード用にExcelシートをCSV変換したいとき
- ✓チームメンバーや取引先にデータを共有する際、Excelを持っていない相手にも開けるCSV形式で提供したいとき
- ✓毎朝の在庫データを基幹システム取込用のCSVとして出力する日次業務をワンクリック化したいとき
- ✓BIツールやGoogleスプレッドシートに読み込ませるためのデータファイルを定期的に生成したいとき
💡 実装のヒント
- ▸出力先フォルダのパスに日本語が含まれていてもエラーにならないよう設計されていますが、できるだけ英数字のパスを使用することをお勧めします。
- ▸CSVエクスポート後も元のExcelファイルは変更されません。安心してエクスポートを実行してください。
- ▸毎回同じフォルダにエクスポートする場合は、マクロのコードにデフォルトパスを設定しておくと操作が更に楽になります。
- ▸CSVには値のみが保存され、数式・書式・複数シートは含まれません。計算結果を渡したい場合はこの仕様がむしろ安全に働きます。
- ▸取引先システムがShift-JIS指定の場合は、出力後にメモ帳等で文字コードを確認し、必要ならマクロの保存形式を変更してください。
💻 VBAコード
' ExportToCSV
' -----------------
' Macro Name: ExportToCSV
' Description: アクティブシートをCSVファイルとしてエクスポートします
' Parameters: なし
' Returns: なし
' Usage: ExportToCSV を実行すると、現在のシートがCSV形式で保存されます
' -----------------
Sub ExportToCSV()
On Error GoTo ErrorHandler
Dim ws As Worksheet
Dim csvPath As String
Dim fileNum As Integer
Dim lastRow As Long
Dim lastCol As Long
Dim i As Long
Dim j As Long
Dim lineStr As String
Dim cellVal As String
Set ws = ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
If lastRow < 1 Then
MsgBox "データが見つかりません", vbCritical, "エラー"
Exit Sub
End If
csvPath = ws.Parent.Path & "\" & ws.Name & ".csv"
fileNum = FreeFile
Open csvPath For Output As #fileNum
For i = 1 To lastRow
lineStr = ""
For j = 1 To lastCol
cellVal = CStr(ws.Cells(i, j).Value)
If InStr(cellVal, ",") > 0 Or InStr(cellVal, vbCrLf) > 0 Then
cellVal = """" & Replace(cellVal, """", """""") & """"
End If
If j = 1 Then
lineStr = cellVal
Else
lineStr = lineStr & "," & cellVal
End If
Next j
Print #fileNum, lineStr
Next i
Close #fileNum
MsgBox "CSVを保存しました:" & vbCrLf & csvPath, vbInformation, "完了"
Exit Sub
ErrorHandler:
If fileNum > 0 Then Close #fileNum
MsgBox "エラーが発生しました:" & vbCrLf & Err.Description, vbCritical, "エラー"
End Sub