Excel VBA 逆引き集 | CSVで保存

Excel VBA
スポンサーリンク

CSVで保存

「シートや範囲をCSVに出力したい」を最短で。先頭ゼロ、日付変換、文字コード、カンマや改行の扱いまで、初心者向けに安全テンプレートで整理します。

基本：アクティブシートをCSVで保存（最短）

Sub SaveCsv_Basic()
    Application.DisplayAlerts = False           '上書き確認を抑止
    ActiveWorkbook.SaveAs _
        Filename:="C:\Data\export.csv", _
        FileFormat:=xlCSV                        'Shift-JISのCSV（Windows標準）
    Application.DisplayAlerts = True
End Sub
VB
  • ポイント:
    • FileFormat指定: 一番手軽。アクティブシートのみがCSV化されます（他のシートは無視）。
    • 上書き確認: 業務で自動保存するなら DisplayAlerts を一時的に False に。

UTF-8で保存（日本語の文字化け対策）

Sub SaveCsv_UTF8()
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs _
        Filename:="C:\Data\export_utf8.csv", _
        FileFormat:=xlCSVUTF8                   'UTF-8のCSV（新しめのExcelで利用可）
    Application.DisplayAlerts = True
End Sub
VB
  • ポイント:
    • UTF-8: システムやWeb連携で求められることが多い。環境によっては xlCSVUTF8 が使えない場合があるため、その際は下記の「自前書き出し」を使用。

範囲だけをCSVに出力（自前で安全書き出し）

Sub SaveCsv_RangeToFile()
    Dim rg As Range
    Set rg = Range("A1").CurrentRegion          '出力範囲（必要に応じて明示指定に変更）

    Dim fn As Integer, path As String
    path = ThisWorkbook.Path & "\export_range.csv"
    fn = FreeFile
    Open path For Output As #fn                 'テキスト書き出し（Shift-JIS）

    Dim r As Long, c As Long
    For r = 1 To rg.Rows.Count
        Dim line As String: line = ""
        For c = 1 To rg.Columns.Count
            Dim s As String: s = CStr(rg.Cells(r, c).Value)
            'ダブルクォートと改行・カンマ対策：RFC風にトークンをクォート
            s = Replace(s, """", """""")
            If InStr(s, ",") > 0 Or InStr(s, vbCr) > 0 Or InStr(s, vbLf) > 0 Then
                s = """" & s & """"
            End If
            If c > 1 Then line = line & ","
            line = line & s
        Next c
        Print #fn, line
    Next r
    Close #fn
End Sub
VB
  • ポイント:
    • 安全なCSV: カンマ・改行・ダブルクォートを正しくエスケープ。
    • 範囲限定: 必要なセルだけ出力でき、シート構造に依存しない。

UTF-8で自前書き出し（ADODB.Stream）

Sub SaveCsv_UTF8_Stream()
    Dim rg As Range: Set rg = Range("A1").CurrentRegion

    'CSV文字列を組み立て
    Dim r As Long, c As Long, sb As String
    For r = 1 To rg.Rows.Count
        Dim parts() As String
        ReDim parts(1 To rg.Columns.Count)
        For c = 1 To rg.Columns.Count
            Dim s As String: s = CStr(rg.Cells(r, c).Value)
            s = Replace(s, """", """""")
            If InStr(s, ",") > 0 Or InStr(s, vbCr) > 0 Or InStr(s, vbLf) > 0 Then
                s = """" & s & """"
            End If
            parts(c) = s
        Next
        sb = sb & Join(parts, ",") & vbCrLf
    Next

    'UTF-8で書き出し（BOMなし）
    Dim st As Object: Set st = CreateObject("ADODB.Stream")
    st.Type = 2                 'adTypeText
    st.Charset = "UTF-8"
    st.Open
    st.WriteText sb
    st.SaveToFile ThisWorkbook.Path & "\export_utf8.csv", 2 'adSaveCreateOverWrite
    st.Close
End Sub
VB
  • ポイント:
    • 文字コード指定: UTF-8で確実に保存。BOMが必要なら、先にバイナリで BOM を書いてからテキスト追記する方法もあります。

複数シートをそれぞれCSVで保存（業務定番）

Sub SaveCsv_MultiSheets()
    Dim sh As Worksheet
    Application.DisplayAlerts = False
    For Each sh In ThisWorkbook.Worksheets
        sh.Copy                                      'シートを新規ブックへ
        With ActiveWorkbook
            .SaveAs _
                Filename:=ThisWorkbook.Path & "\" & sh.Name & ".csv", _
                FileFormat:=xlCSV
            .Close SaveChanges:=False                 '都度閉じる
        End With
    Next
    Application.DisplayAlerts = True
End Sub
VB
  • ポイント:
    • 1シートずつ: CSVは「シート単位」。コピー→保存→閉じるの流れが安定。
    • 名前衝突対策: シート名に不正文字がある場合はファイル名を調整。

区切り文字を変えたい（セミコロンなど）

Sub SaveCsv_Semicolon()
    Dim rg As Range: Set rg = Range("A1").CurrentRegion
    Dim fn As Integer: fn = FreeFile
    Open ThisWorkbook.Path & "\export_semicolon.csv" For Output As #fn

    Dim r As Long, c As Long, line As String
    For r = 1 To rg.Rows.Count
        line = ""
        For c = 1 To rg.Columns.Count
            Dim s As String: s = CStr(rg.Cells(r, c).Value)
            s = Replace(s, """", """""")
            If InStr(s, ";") > 0 Or InStr(s, vbCr) > 0 Or InStr(s, vbLf) > 0 Then
                s = """" & s & """"
            End If
            If c > 1 Then line = line & ";"
            line = line & s
        Next
        Print #fn, line
    Next
    Close #fn
End Sub
VB
  • ポイント:
    • ロケール依存回避: 受け側システムがセミコロン区切りを要求する場合に。

例題で練習

'例題1：相対パスに「当日名」でUTF-8保存
Sub Example_SaveToday_UTF8()
    Dim fname As String
    fname = ThisWorkbook.Path & "\out_" & Format(Date, "yyyymmdd") & ".csv"
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=fname, FileFormat:=xlCSVUTF8
    Application.DisplayAlerts = True
End Sub

'例題2：選択範囲だけを厳密CSV（カンマ・改行・クォート対応）
Sub Example_SaveSelection_CSV()
    If TypeName(Selection) <> "Range" Then Exit Sub
    Dim rg As Range: Set rg = Selection
    Dim fn As Integer: fn = FreeFile
    Open ThisWorkbook.Path & "\selection.csv" For Output As #fn
    Dim r As Long, c As Long
    For r = 1 To rg.Rows.Count
        Dim parts() As String
        ReDim parts(1 To rg.Columns.Count)
        For c = 1 To rg.Columns.Count
            Dim s As String: s = CStr(rg.Cells(r, c).Value)
            s = Replace(s, """", """""")
            If InStr(s, ",") > 0 Or InStr(s, vbCr) > 0 Or InStr(s, vbLf) > 0 Then s = """" & s & """"
            parts(c) = s
        Next
        Print #fn, Join(parts, ",")
    Next
    Close #fn
End Sub

'例題3：複数シートを個別CSV（シート名で保存）
Sub Example_SaveEachSheet()
    Dim w As Worksheet
    Application.DisplayAlerts = False
    For Each w In ThisWorkbook.Worksheets
        w.Copy
        ActiveWorkbook.SaveAs _
            Filename:=ThisWorkbook.Path & "\" & w.Name & ".csv", _
            FileFormat:=xlCSV
        ActiveWorkbook.Close False
    Next
    Application.DisplayAlerts = True
End Sub
VB

実務の落とし穴と対策

  • 先頭ゼロと日付変換:
    • 対策: 取り込み側で「文字列扱い」にするか、出力前に必要な列を文字列化（例：=”00123″ 形式）を検討。
  • 文字コードのズレ:
    • 対策: 受け側がUTF-8なら xlCSVUTF8（非対応環境はADODB.StreamでUTF-8書き出し）。Windows系レガシーなら xlCSV（Shift-JIS）。
  • 改行・カンマ・ダブルクォート:
    • 対策: フィールド内にそれらが含まれる場合は、ダブルクォートで囲み、内部のダブルクォートは2つにエスケープ。
  • 複数シートの扱い:
    • 対策: CSVは1シートのみ。複数は「コピー→保存→閉じる」をループ。
  • 保存確認ダイアログ:
    • 対策: 自動化では DisplayAlerts を一時的に False。終了時に必ず True に戻す。
  • ファイル名の禁止文字:
    • 対策: /:*?”<>| をファイル名から除去してから保存。
スポンサーリンク
タイトルとURLをコピーしました