🔄
ExportToCSV
データ処理アクティブシートをCSVファイルとしてエクスポートします
🎬 デモGIF準備中
📖 使い方
- VBAエディタを開く（Alt + F11）
- モジュールを挿入（挿入 > モジュール）
- 下記VBAコードをコピー&ペースト
- ブック上で実行（Alt + F8 でマクロ選択）
💡 実行例： ExportToCSV を実行すると、現在のシートがCSV形式で保存されます
💻 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