Excel標準VBAだけで事務マクロを作る：失敗しやすいポイント

事務のExcelマクロは、動けば勝ち……ではなく、**「運用で壊れない」「他人のPCでも落ちない」「データが壊れない」**が勝ちです。
この記事では、**参照設定なし・外部ライブラリなし（Excel標準VBAのみ）**で作る前提で、実務で事故りやすいポイントを潰しながら、

CSV取り込み → 型崩れ防止 → クレンジング → テーブル化
シート一覧からPDF一括出力 → ファイル名事故防止

の2本を「そのまま貼って動くコード」で紹介します。

1 この記事のゴール：事務マクロで“よくある死”を避ける
2 まず最重要：Excelアプリ設定の退避＆復旧（これが無いと事故がデカい）
- 2.1 方針
3 実務で刺さる例①：CSV取り込みの“型崩れ”を完全回避してテーブル化する
4 実務で刺さる例②：シート一覧からPDFを一括で作る（禁止文字で落ちない）
5 「そのまま貼って動く」完成コード（標準VBAのみ）
6 コードの読みどころ：事故を防ぐための“意図”を解説

この記事のゴール：事務マクロで“よくある死”を避ける

事務マクロの死因はだいたいこの辺です。

先頭ゼロが消える（001234 → 1234）
日付が別の日になる（地域設定で解釈変わる）
ActiveWorkbook/Selection依存で別ブックに上書き
途中エラーで ScreenUpdating=False のまま固まる
フィルタ条件が残って件数がズレる
ファイル名に禁止文字が混ざって保存できない

つまり、「正しく動く」より先に「壊れ方が最悪にならない設計」が必要です。

まず最重要：Excelアプリ設定の退避＆復旧（これが無いと事故がデカい）

マクロ高速化でよくやるのが、

ScreenUpdating = False
Calculation = Manual
EnableEvents = False

ですが、途中でエラーが起きるとそのまま戻らず、Excelが壊れたように見えます。
だから、**必ず“退避→復旧”**を作ります。

方針

実行前の状態を保存
実行後（成功でも失敗でも）必ず元に戻す
ログを残す

これだけで、運用品質が一段上がります。

実務で刺さる例①：CSV取り込みの“型崩れ”を完全回避してテーブル化する

なぜCSV取り込みは危険か

Excelは勝手に型変換します。

00123 を数値化して 123 にする
長いIDを指数表記にする（1.23E+15）
日付っぽい文字列を日付に変換する
取引先コードや郵便番号が壊れる

この事故は、後から元に戻せません。
だから「取り込む瞬間に」防ぐ必要があります。

解決策：OpenTextで“全列を文字列”として取り込む

標準VBAでこれができます。ポイントは Workbooks.OpenText の FieldInfo。
各列を「文字列扱い」に指定して読み込みます。

追加でやるべきこと：クレンジング（正規化）

一致判定や集計前に、以下を揃えないと地獄になります。

全角スペース／半角スペース
セル内改行
連続空白
前後空白

さらに実務だと表記ゆれ（㈱/（株）/株式会社）もありますが、まずは土台として「見えないゴミ」を落とすのが先。

最後にテーブル化（ListObject）

取り込んだデータはテーブル（例：tblData）にしておくと、
フィルタ・ピボット・参照が安定します。
「範囲が伸びたから式がズレた」事故が減ります。

実務で刺さる例②：シート一覧からPDFを一括で作る（禁止文字で落ちない）

PDF一括は簡単そうで、運用で落ちます。

ファイル名に : / \ ? * など禁止文字が混ざる
（顧客名、案件名、商品名由来で頻出）
既存ファイルと衝突して上書きする
PCによって印刷設定がズレる

だから最低限、

ファイル名サニタイズ
実行ログ
必要なら PageSetup を固定

は入れたい。

「そのまま貼って動く」完成コード（標準VBAのみ）

以下は、上の方針を全部入れた実装です。

アプリ設定退避/復旧
LOGシートへログ
CSV列数推定（ダブルクォート内カンマを無視）
全列文字列としてCSV取り込み
正規化（配列で高速）
テーブル化
PDF一括出力（禁止文字対策）

貼り付け先：VBE（Alt+F11）→ 挿入 → 標準モジュール

Option Explicit

'============================================================
' 共通：アプリ設定退避＆復旧（途中で落ちてもExcel設定が死なない）
'============================================================
Private Type TAppState
    ScreenUpdating As Boolean
    EnableEvents As Boolean
    DisplayAlerts As Boolean
    Calculation As XlCalculation
End Type

Private gState As TAppState

Private Sub App_OptimizeBegin()
    With Application
        gState.ScreenUpdating = .ScreenUpdating
        gState.EnableEvents = .EnableEvents
        gState.DisplayAlerts = .DisplayAlerts
        gState.Calculation = .Calculation

        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With
End Sub

Private Sub App_OptimizeEnd()
    With Application
        .ScreenUpdating = gState.ScreenUpdating
        .EnableEvents = gState.EnableEvents
        .DisplayAlerts = gState.DisplayAlerts
        .Calculation = gState.Calculation
    End With
End Sub

'============================================================
' 共通：シート確保＆ログ
'============================================================
Private Function EnsureSheet(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
    End If
    Set EnsureSheet = ws
End Function

Private Sub LogLine(ByVal msg As String)
    Dim ws As Worksheet, r As Long
    Set ws = EnsureSheet("LOG")

    If ws.Cells(1, 1).Value = "" Then
        ws.Cells(1, 1).Value = "Timestamp"
        ws.Cells(1, 2).Value = "Message"
    End If

    r = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
    ws.Cells(r, 1).Value = Now
    ws.Cells(r, 2).Value = msg
End Sub

'============================================================
' 共通：ファイル選択／フォルダ選択
'============================================================
Private Function PickFile(ByVal title As String, ByVal filterDesc As String, ByVal filterPattern As String) As String
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = title
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add filterDesc, filterPattern
        If .Show <> -1 Then
            PickFile = ""
        Else
            PickFile = .SelectedItems(1)
        End If
    End With
End Function

Private Function PickFolder(ByVal title As String) As String
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .Title = title
        If .Show <> -1 Then
            PickFolder = ""
        Else
            PickFolder = .SelectedItems(1)
        End If
    End With
End Function

'============================================================
' 共通：CSVの列数を正しく数える（ダブルクォート内のカンマは無視）
'============================================================
Private Function CountCsvFields(ByVal line1 As String) As Long
    Dim i As Long, ch As String, inQuotes As Boolean, cnt As Long
    cnt = 1
    inQuotes = False

    For i = 1 To Len(line1)
        ch = Mid$(line1, i, 1)
        If ch = """" Then
            inQuotes = Not inQuotes
        ElseIf ch = "," And Not inQuotes Then
            cnt = cnt + 1
        End If
    Next i

    CountCsvFields = cnt
End Function

Private Function BuildFieldInfoText(ByVal nFields As Long) As Variant
    ' Workbooks.OpenText の FieldInfo 用：全列を文字列（xlTextFormat=2）
    Dim fi() As Integer
    Dim i As Long
    ReDim fi(1 To nFields, 1 To 2)
    For i = 1 To nFields
        fi(i, 1) = i
        fi(i, 2) = 2 ' xlTextFormat
    Next i
    BuildFieldInfoText = fi
End Function

'============================================================
' 共通：最終セル取得（UsedRange肥大でも比較的安全）
'============================================================
Private Function GetLastRow(ByVal ws As Worksheet) As Long
    Dim f As Range
    Set f = ws.Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    If f Is Nothing Then
        GetLastRow = 0
    Else
        GetLastRow = f.Row
    End If
End Function

Private Function GetLastCol(ByVal ws As Worksheet) As Long
    Dim f As Range
    Set f = ws.Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
    If f Is Nothing Then
        GetLastCol = 0
    Else
        GetLastCol = f.Column
    End If
End Function

'============================================================
' 共通：文字正規化（空白/改行/制御文字/全角スペース）
'============================================================
Private Function NormalizeText(ByVal s As String) As String
    Dim t As String
    t = s

    ' 改行類を空白へ
    t = Replace(t, vbCrLf, " ")
    t = Replace(t, vbCr, " ")
    t = Replace(t, vbLf, " ")

    ' 全角スペース → 半角
    t = Replace(t, ChrW(&H3000), " ")

    ' 連続空白を詰める（ざっくり）
    Do While InStr(t, "  ") > 0
        t = Replace(t, "  ", " ")
    Loop

    ' 前後空白を削る
    t = Trim$(t)

    NormalizeText = t
End Function

'============================================================
' 共通：ファイル名の禁止文字を潰す
'============================================================
Private Function SanitizeFileName(ByVal s As String) As String
    Dim bad As Variant, i As Long
    bad = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
    For i = LBound(bad) To UBound(bad)
        s = Replace(s, CStr(bad(i)), "_")
    Next i
    SanitizeFileName = s
End Function

'============================================================
' 例1：CSV取り込み→正規化→テーブル化（tblData）
'============================================================
Public Sub ImportCsv_Clean_Table()
    Dim csvPath As String
    Dim wsData As Worksheet
    Dim wbCsv As Workbook
    Dim headerLine As String
    Dim nFields As Long
    Dim fi As Variant
    Dim ff As Integer
    Dim lastR As Long, lastC As Long
    Dim rng As Range
    Dim arr As Variant
    Dim r As Long, c As Long

    On Error GoTo EH
    App_OptimizeBegin

    Set wsData = EnsureSheet("DATA")

    csvPath = PickFile("取り込むCSVを選択", "CSV Files", "*.csv")
    If csvPath = "" Then GoTo Cleanup

    LogLine "CSV import start: " & csvPath

    ' 1行目だけ読んで列数推定（クォート考慮）
    ff = FreeFile
    Open csvPath For Input As #ff
        Line Input #ff, headerLine
    Close #ff

    nFields = CountCsvFields(headerLine)
    fi = BuildFieldInfoText(nFields)

    ' OpenTextで全列を文字列として取り込む（型崩れ防止）
    Workbooks.OpenText _
        Filename:=csvPath, _
        DataType:=xlDelimited, _
        Comma:=True, _
        TextQualifier:=xlTextQualifierDoubleQuote, _
        FieldInfo:=fi, _
        Local:=True

    Set wbCsv = ActiveWorkbook ' OpenText直後はこれがCSVブック

    ' DATAシートへ値貼り（元CSVブックは閉じる）
    wsData.Cells.Clear

    lastR = GetLastRow(wbCsv.Worksheets(1))
    lastC = GetLastCol(wbCsv.Worksheets(1))
    If lastR = 0 Or lastC = 0 Then
        Err.Raise vbObjectError + 1, , "CSVが空です"
    End If

    Set rng = wbCsv.Worksheets(1).Range(wbCsv.Worksheets(1).Cells(1, 1), wbCsv.Worksheets(1).Cells(lastR, lastC))
    wsData.Range("A1").Resize(rng.Rows.Count, rng.Columns.Count).Value2 = rng.Value2

    wbCsv.Close SaveChanges:=False
    Set wbCsv = Nothing

    ' 正規化（配列で一括処理：速い）
    lastR = GetLastRow(wsData)
    lastC = GetLastCol(wsData)
    Set rng = wsData.Range(wsData.Cells(1, 1), wsData.Cells(lastR, lastC))

    arr = rng.Value2
    For r = 1 To UBound(arr, 1)
        For c = 1 To UBound(arr, 2)
            If VarType(arr(r, c)) = vbString Then
                arr(r, c) = NormalizeText(CStr(arr(r, c)))
            End If
        Next c
    Next r
    rng.Value2 = arr

    ' 既存テーブルがあれば削除して作り直し（フィルタ残り事故防止）
    On Error Resume Next
    wsData.ListObjects("tblData").Delete
    On Error GoTo EH

    wsData.ListObjects.Add(xlSrcRange, rng, , xlYes).Name = "tblData"

    wsData.Columns.AutoFit
    LogLine "CSV import done: rows=" & (lastR - 1) & ", cols=" & lastC

Cleanup:
    App_OptimizeEnd
    Exit Sub

EH:
    LogLine "ERROR ImportCsv_Clean_Table: " & Err.Number & " " & Err.Description
    If Not wbCsv Is Nothing Then
        On Error Resume Next
        wbCsv.Close SaveChanges:=False
        On Error GoTo 0
    End If
    App_OptimizeEnd
    MsgBox "エラー: " & Err.Description, vbExclamation
End Sub

'============================================================
' 例2：設定シートの一覧でPDF一括出力
'  - 設定シート A列：出力したいシート名（2行目以降）
'============================================================
Public Sub ExportSheetsToPdf_Batch()
    Dim wsSet As Worksheet
    Dim outDir As String
    Dim r As Long
    Dim shName As String
    Dim ws As Worksheet
    Dim pdfName As String

    On Error GoTo EH
    App_OptimizeBegin

    Set wsSet = EnsureSheet("設定")
    outDir = PickFolder("PDFの出力先フォルダを選択")
    If outDir = "" Then GoTo Cleanup

    LogLine "PDF batch start: " & outDir

    r = 2
    Do While wsSet.Cells(r, 1).Value <> ""
        shName = CStr(wsSet.Cells(r, 1).Value)

        On Error Resume Next
        Set ws = ThisWorkbook.Worksheets(shName)
        On Error GoTo EH

        If ws Is Nothing Then
            LogLine "SKIP (sheet not found): " & shName
        Else
            ' ファイル名（禁止文字対策）
            pdfName = SanitizeFileName(shName) & "_" & Format(Now, "yyyymmdd_hhnnss") & ".pdf"

            ' 必要ならここでPageSetupを固定する（余白/方向/拡大縮小/印刷範囲）
            ws.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=outDir & "\" & pdfName, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False

            LogLine "PDF exported: " & shName & " -> " & pdfName
        End If

        Set ws = Nothing
        r = r + 1
    Loop

Cleanup:
    App_OptimizeEnd
    Exit Sub

EH:
    LogLine "ERROR ExportSheetsToPdf_Batch: " & Err.Number & " " & Err.Description
    App_OptimizeEnd
    MsgBox "エラー: " & Err.Description, vbExclamation
End Sub

コードの読みどころ：事故を防ぐための“意図”を解説

1) CSV列数推定（CountCsvFields）

CSVは「カンマ区切り」だけど、ダブルクォート内のカンマは区切りではありません。
例："Tokyo,Japan" は1項目です。
このケースを無視すると列数がズレ、取り込みが壊れます。

だから、1行目を読み、クォート内かどうかを見ながらカンマ数を数えています。

2) 全列を文字列として読み込む（BuildFieldInfoText / OpenText）

ここが最重要です。
この指定があることで、先頭ゼロや長いIDが守られます。

3) 正規化を配列で処理（速度と安全性）

セルを1個ずつ触ると遅い。
さらに、途中でユーザーが触ると選択状態が変わる事故も増えます。

rng.Value2 を配列に入れる
配列を加工
まとめて書き戻す

これが「速くて壊れにくい」基本形です。

4) フィルタ残り事故を潰す（テーブル作り直し）

テーブルは便利ですが、フィルタ状態が残ると件数がズレます。
なので、既存テーブルがあれば一度消して作り直しています。

5) PDF出力の禁止文字対策（SanitizeFileName）

顧客名や案件名に : などが混ざるのは日常。
禁止文字が入ると保存で落ちるため、全部 _ に置換しています。

6) ログ（LogLine）

「昨日動いたのに今日動かない」を潰す一番の武器がログです。
最低限でも、

いつ
何を処理したか
件数
エラー内容

が残ると復旧が圧倒的に速くなります。