ExcelのVBAでCSVをShift_JISで出力する方法｜Shift_JISにない文字が「?」に変わるのを出力前に見つけて置き換える

2026年10月10日 2026年10月10日

ゆきむら

取り込み先のシステムで「CSVはShift_JISで」と決められている場合、ExcelのVBAから出力する方法は大きく2つあります。

ブックを xlCSV 形式で保存する
ADODB.Stream で文字コードを指定し、テキストとして書き出す

どちらの方法でも、Shift_JISで表せない文字は出力の時点で「?」や別の文字に置き換わり、元には戻せません。保存はエラーにならずに終わってしまうため、取り込んだあとで気づくことの多い問題です。

この記事では、次の流れをVBAのコード付きで説明します。

出力前に、Shift_JISで表せない文字を洗い出す
置換表に沿って置き換えてから保存する
件数と内容を確かめる

先に確認すること：取り込み先の「Shift_JIS」はどこまでの文字を含むか

Windowsで「Shift_JIS」と呼ばれているものの多くは、実際にはMicrosoftが拡張した文字を含むCP932（Windows-31J）です。CP932には、JIS規格のShift_JISにはない丸数字（①）、ローマ数字（Ⅰ）、「髙」「﨑」といった一部の漢字など、いわゆる機種依存文字が含まれています。

そのため、問題になる文字は次の2種類に分けて考えます。

文字の例	CP932で表せるか	起きること
絵文字、「𠮷」（つちよし）、アクセント付きの欧文字（éなど）	表せない	出力のときに「?」や似た別の文字に置き換わる
丸数字（①）、「髙」「﨑」、「㈱」	表せる	Excelからは出力できる。ただし取り込み先がJIS規格の範囲しか受け付けない場合は、文字化けやエラーになることがある
一般的なひらがな・カタカナ・漢字・英数字	表せる	問題になりにくい

1つ目はVBAで機械的に見つけられます。2つ目は取り込み先の仕様によって扱いが変わるので、仕様書や担当者に「丸数字や『髙』などの機種依存文字を受け付けるか」を確認してください。受け付けない文字は、後で説明する置換表に登録して扱います。

ほかのOSやシステムから来たデータには、見た目は同じでもコードが違う文字（波ダッシュ「〜」など）が混じっていることがあります。こうした文字は、変換できない文字として見つかる場合があります。そのときは、チェック結果に出るコードを見て、置換表で取り込み先が受け付ける文字にそろえます。

xlCSVでの保存とADODB.Streamの使い分け

項目	xlCSVで保存	ADODB.Streamで書き出し
文字コード	Windowsの既定（ANSI）のコードページ。日本語環境ではふつうCP932	コードの中で "Shift_JIS" を指定する
書き出される値	セルの表示形式に沿った値	VBAで文字列に変換した値（形式は自分で整える）
引用符の付け方	Excelに任せる	自分で決める
置き換え	シートの値を直してから保存する	書き出しながら置き換えられる。元のシートは変わらない
コードの量	少ない	多い

置き換えが必要なく、画面に表示されているとおりの値を出せばよいなら、xlCSVで足ります。人名の「髙」を「高」に変えるなど置き換えが必要で、元のデータは変えたくない場合は、ADODB.Streamのほうが扱いやすくなります。

なお、Windowsの地域設定で「ベータ: ワールドワイド言語サポートで Unicode UTF-8 を使用」を有効にしていると、既定のコードページが変わります。この場合、xlCSVで保存してもShift_JISにならない可能性があります。どちらの方法でも、出力したあとに文字コードを必ず確認してください。

方法1：xlCSVでShift_JISのCSVを保存する

Sub SaveSjisCsvByXlCsv()
    Dim path As String
    If ThisWorkbook.Path = "" Then
        MsgBox "先にこのブックを保存してください。"
        Exit Sub
    End If
    path = ThisWorkbook.Path & "\output_sjis.csv"

    ActiveSheet.Copy                        ' 作業中のシートを新しいブックに複製
    Application.DisplayAlerts = False       ' 上書きの確認を出さない
    ActiveWorkbook.SaveAs Filename:=path, FileFormat:=xlCSV
    ActiveWorkbook.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub

シートを新しいブックに複製してから保存するため、作業中のブックがCSV形式に変わることはありません。
FileFormat:=xlCSV で保存すると、UTF-8ではなくWindowsの既定のコードページで書き出されます。
保存する前に、次の方法2にある CheckSjisChars で、変換できない文字がないか確認してください。見つかった場合は、元のシートを直すか、方法2で出力します。

方法2：ADODB.Streamで置き換えながら出力する

準備：置換表シートを作る

マクロを書くブックに「置換表」という名前のシートを作ります。A列に元の文字、B列に置き換え後の文字を入れ、1行目は見出しにします。

A列：元の文字	B列：置き換え後
髙	高
﨑	崎
①	(1)
②	(2)
㈱	(株)

A列には1文字ずつ登録します。チェック用のマクロは1文字単位で照合するためです。
何を登録するかは、取り込み先の仕様と業務上の扱いで決めます。人名や社名の字体を変えると、宛名や照合に影響が出ることがあります。関係者と合意してから登録してください。
絵文字など削除してよい文字は、B列を空欄にしておくと削除されます。

コード

標準モジュールに貼り付けます。Scripting.Dictionary と ADODB.Stream は CreateObject で呼び出すので、参照設定は要りません。

Option Explicit

Private Const LCID_JA As Long = 1041    ' 日本語のロケールID

' s の i 文字目から1文字を取り出す（絵文字などのサロゲートペアは2単位をまとめる）
Private Function GetChar(ByVal s As String, ByVal i As Long) As String
    Dim code As Long
    code = AscW(Mid$(s, i, 1)) And &HFFFF&
    If code >= &HD800& And code <= &HDBFF& And i < Len(s) Then
        GetChar = Mid$(s, i, 2)
    Else
        GetChar = Mid$(s, i, 1)
    End If
End Function

' Shift_JIS（CP932）に変換して戻したとき、元の文字に戻るか
Private Function CanEncodeSjis(ByVal ch As String) As Boolean
    CanEncodeSjis = (StrConv(StrConv(ch, vbFromUnicode, LCID_JA), vbUnicode, LCID_JA) = ch)
End Function

' 文字を U+XXXX の形で返す
Private Function CodePointText(ByVal ch As String) As String
    Dim hi As Long, lo As Long, cp As Long
    hi = AscW(Left$(ch, 1)) And &HFFFF&
    If Len(ch) = 2 Then
        lo = AscW(Right$(ch, 1)) And &HFFFF&
        cp = (hi - &HD800&) * &H400& + (lo - &HDC00&) + &H10000
    Else
        cp = hi
    End If
    CodePointText = "U+" & Right$("0000" & Hex$(cp), IIf(cp > &HFFFF&, 5, 4))
End Function

' 「置換表」シートのA列（元の文字）とB列（置き換え後）を読み込む。1行目は見出し
Private Function LoadReplaceMap() As Object
    Dim map As Object, ws As Worksheet, r As Long, lastRow As Long
    Set map = CreateObject("Scripting.Dictionary")
    Set ws = ThisWorkbook.Worksheets("置換表")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    For r = 2 To lastRow
        If Len(ws.Cells(r, 1).Value) > 0 Then
            map(CStr(ws.Cells(r, 1).Value)) = CStr(ws.Cells(r, 2).Value)
        End If
    Next r
    Set LoadReplaceMap = map
End Function

' 指定した名前のシートを空にして返す。なければ末尾に作る
Private Function PrepareSheet(ByVal sheetName As String) As Worksheet
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(sheetName)
    On Error GoTo 0
    If ws Is Nothing Then
        Set ws = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        ws.Name = sheetName
    Else
        ws.Cells.Clear
    End If
    Set PrepareSheet = ws
End Function

' カンマ・ダブルクォーテーション・改行を含む値だけを引用符で囲む
Private Function CsvField(ByVal s As String) As String
    If InStr(s, ",") > 0 Or InStr(s, """") > 0 Or InStr(s, vbLf) > 0 Or InStr(s, vbCr) > 0 Then
        CsvField = """" & Replace(s, """", """""") & """"
    Else
        CsvField = s
    End If
End Function

' 出力前の確認：置換表にある文字と、Shift_JISで表せない文字を一覧にする
Sub CheckSjisChars()
    Dim src As Range, data As Variant, map As Object, rep As Worksheet
    Dim r As Long, c As Long, i As Long, outRow As Long
    Dim s As String, ch As String, kind As String
    Dim ngCount As Long, mapCount As Long

    Set src = ActiveSheet.UsedRange
    data = src.Value                        ' 2セル以上ある前提
    Set map = LoadReplaceMap()
    Set rep = PrepareSheet("文字チェック")
    rep.Range("A1:D1").Value = Array("セル", "文字", "コード", "区分")
    outRow = 2

    For r = 1 To UBound(data, 1)
        For c = 1 To UBound(data, 2)
            If Not IsError(data(r, c)) Then
                s = CStr(data(r, c))
                i = 1
                Do While i <= Len(s)
                    ch = GetChar(s, i)
                    kind = ""
                    If map.Exists(ch) Then
                        kind = "置換表で置き換え"
                        mapCount = mapCount + 1
                    ElseIf Not CanEncodeSjis(ch) Then
                        kind = "変換できない"
                        ngCount = ngCount + 1
                    End If
                    If kind <> "" Then
                        rep.Cells(outRow, 1).Value = src.Cells(r, c).Address(False, False)
                        rep.Cells(outRow, 2).Value = ch
                        rep.Cells(outRow, 3).Value = CodePointText(ch)
                        rep.Cells(outRow, 4).Value = kind
                        outRow = outRow + 1
                    End If
                    i = i + Len(ch)
                Loop
            End If
        Next c
    Next r

    MsgBox "変換できない文字：" & ngCount & " 件" & vbCrLf & _
           "置換表で置き換える文字：" & mapCount & " 件", vbInformation
End Sub

' 置換表で置き換えながら、Shift_JISでCSVを書き出す
Sub ExportSjisCsv()
    Dim src As Range, data As Variant, map As Object, key As Variant
    Dim r As Long, c As Long, i As Long
    Dim s As String, ch As String, rowText As String, csvText As String, readBack As String
    Dim lines() As String
    Dim replaced As Long, ngCount As Long, errCount As Long, ngList As String
    Dim path As String, stm As Object

    If ThisWorkbook.Path = "" Then
        MsgBox "先にこのブックを保存してください。"
        Exit Sub
    End If
    path = ThisWorkbook.Path & "\output_sjis.csv"

    Set src = ActiveSheet.UsedRange
    data = src.Value                        ' 2セル以上ある前提
    Set map = LoadReplaceMap()
    ReDim lines(1 To UBound(data, 1))

    For r = 1 To UBound(data, 1)
        rowText = ""
        For c = 1 To UBound(data, 2)
            If IsError(data(r, c)) Then
                s = ""
                errCount = errCount + 1
            Else
                s = CStr(data(r, c))
            End If

            ' 置換表の文字を置き換え、置き換えた文字数を数える
            For Each key In map.Keys
                If InStr(1, s, key, vbBinaryCompare) > 0 Then
                    replaced = replaced + (Len(s) - Len(Replace(s, key, ""))) \ Len(key)
                    s = Replace(s, key, map(key))
                End If
            Next key

            ' 置き換えたあとも、Shift_JISで表せない文字が残っていないか
            i = 1
            Do While i <= Len(s)
                ch = GetChar(s, i)
                If Not CanEncodeSjis(ch) Then
                    ngCount = ngCount + 1
                    If ngCount <= 10 Then
                        ngList = ngList & src.Cells(r, c).Address(False, False) & " " & CodePointText(ch) & vbCrLf
                    End If
                End If
                i = i + Len(ch)
            Loop

            If c > 1 Then rowText = rowText & ","
            rowText = rowText & CsvField(s)
        Next c
        lines(r) = rowText
    Next r

    ' 表せない文字が残っていたら、ファイルを作らずに止める
    If ngCount > 0 Then
        MsgBox "Shift_JISで表せない文字が " & ngCount & " 件あります。出力を中止しました。" & vbCrLf & ngList, vbExclamation
        Exit Sub
    End If

    csvText = Join(lines, vbCrLf) & vbCrLf

    Set stm = CreateObject("ADODB.Stream")
    stm.Type = 2                            ' テキスト
    stm.Charset = "Shift_JIS"
    stm.Open
    stm.WriteText csvText
    stm.SaveToFile path, 2                  ' 2 = 同じ名前のファイルがあれば上書き
    stm.Close

    ' 書き出したファイルを読み直し、書いた内容と同じか確かめる
    stm.Type = 2
    stm.Charset = "Shift_JIS"
    stm.Open
    stm.LoadFromFile path
    readBack = stm.ReadText
    stm.Close

    MsgBox "出力行数（見出しを含む）：" & UBound(lines) & vbCrLf & _
           "置き換えた文字数：" & replaced & vbCrLf & _
           "エラー値のため空欄にしたセル：" & errCount & vbCrLf & _
           "読み直しの結果：" & IIf(readBack = csvText, "一致", "不一致（内容を確認してください）") & vbCrLf & _
           path, vbInformation
End Sub

コードの要点

変換できない文字の見つけ方：StrConv で1文字ずつShift_JIS（CP932）に変換し、もう一度Unicodeに戻して、元の文字と一致するかを比べています。出力したファイルの中で「?」を探す方法では、もともと入っている「?」と区別できません。往復させて比べれば、文字が「?」に変わる場合も、似た文字に置き換わる場合も見つけられます。
機種依存文字は置換表で扱う：「髙」や「①」はCP932で表せるので、往復させて比べても検出されません。取り込み先が受け付けない場合は、置換表に登録すると「置換表で置き換え」として一覧に出ます。
残っていたら止める：置き換えたあとも表せない文字が1件でも残っていれば、ファイルは作りません。最初の10件まで、セルの位置とコードを表示します。
読み直しで確かめる：ADODB.Stream が "Shift_JIS" をどう扱うかは、StrConv の判定と細かい部分で違う可能性があります。そのため、書き出したファイルを同じ文字コードで読み直し、書いた内容と一致するかを最後に比べています。
値の変換：セルの値を CStr で文字列にしています。先頭の0が残るのは、セルに文字列として入っている場合だけです。日付は、その環境の日付形式（日本語環境なら「2026/10/07」のような形）になります。取り込み先が決まった形式を求める場合は、該当する列だけ Format で整えてください。
改行コード：行の区切りはCRLFです。取り込み先がLFを求める場合は、Join の区切り文字と最後に付けている vbCrLf を vbLf に変えます。

使う順番

出力したいシートを表示した状態で CheckSjisChars を実行します。
「文字チェック」シートに出た文字を確認し、置き換える文字を置換表に追加します。区分が「変換できない」の文字がなくなるまで、1と2を繰り返します。
出力したいシートに戻って ExportSjisCsv を実行します。
表示される件数と読み直しの結果を確認します。

出力したあとの確かめ方

行数：メッセージに出る出力行数が、シートの行数（見出しを含む）と合っているか確認します。取り込み先が取り込んだ件数を表示する場合は、見出しを除いた件数と比べます。
読み直しの結果：「一致」になっているか確認します。「不一致」なら、そのファイルは使わずに原因を調べます。
文字コード：文字コードを表示できるテキストエディタでファイルを開き、Shift_JIS系の表示になっているか確認します。表記（SJIS、Shift_JIS、CP932など）はエディタによって異なります。
置き換え後の文字：置換表に登録した文字が、意図したとおりに置き換わっているか、数件を目で見て確認します。
試しに取り込む：本番の前に、数行だけ取り込み先で試します。文字化けや列ずれがないか確認できます。

うまくいかないときの確認表

症状	確認すること
「インデックスが有効範囲にありません」と出る	「置換表」シートがマクロを書いたブックにあるか。シート名の全角・半角や前後の空白
出力すると「?」が残る	文字チェックで「変換できない」が0件になっているか。置き換え後の文字そのものがShift_JISで表せるか
先頭の0が消える	元のセルが数値になっていないか。文字列として入っているか
日付の形式が取り込み先と合わない	`CStr` の結果は環境の日付形式になる。`Format` で形式を指定する
取り込み先で文字化けする	取り込み先がUTF-8を前提にしていないか。機種依存文字を受け付けるか
セル内の改行で行がずれる	該当する値は引用符で囲んで出力される。取り込み先が、引用符の中の改行を受け付けるか確認する
ファイルに書き込めずエラーになる	同じ名前のCSVを開いたままにしていないか。保存先のフォルダに書き込めるか
処理が遅い	セルの数と置換表の行数。全セルに対して置換表を順に当てているため、どちらかが多いと時間がかかる

Shift_JISで出力するときに大切なのは、取り込み先が受け付ける文字の範囲を先に確かめておくことです。そのうえで「出力前に洗い出す → 置換表で直す → 読み直しと件数で確かめる」の順に進めると、取り込んだあとで「?」に気づくことを防げます。

この記事を書いた人

ゆきむら

ひとり仕事・小さな事業の実務を軽くする記事や、小さなツールを作っています。会計・データ整理・Excel・CSV・文書・連絡・記録・業務改善などを扱っています。制度・税務に関する記事では、国税庁などの一次資料を確認し、制度上のルールと実務上の工夫を分けて整理することを基本方針にしています。姉妹サイト「あたまの道具箱」も運営しています。