Excel VBA 逆引き集 | シート名を一括変更

Excel VBA
スポンサーリンク

シート名を一括変更

「連番」「接頭辞・接尾辞」「セル一覧から」「置換」「日付付与」など、よく使うパターンを初心者でも迷わず使えるように、動くコードと安全テンプレートでまとめました。エラーの出やすい重複名や禁止文字にもきちんと対策します。

基本：最短で連番リネーム

Sub RenameSheets_Sequential()
    Dim ws As Worksheet
    Dim i As Long: i = 1 '開始番号
    For Each ws In ThisWorkbook.Worksheets
        ws.Name = CStr(i)
        i = i + 1
    Next
End Sub
VB
  • ポイント:
    • 全シート対象: For Eachで一括変更。
    • シンプル: 連番を文字列化して名前に設定。

安全テンプレート：禁止文字・31文字制限・重複回避

Function SanitizeSheetName(rawName As String) As String
    Dim s As String: s = Trim$(rawName)
    '禁止文字置換
    s = Replace(s, ":", "_")
    s = Replace(s, "/", "_")
    s = Replace(s, "\", "_")
    s = Replace(s, "?", "_")
    s = Replace(s, "*", "_")
    s = Replace(s, "[", "_")
    s = Replace(s, "]", "_")
    '長さ制限
    If Len(s) = 0 Then s = "Sheet"
    If Len(s) > 31 Then s = Left$(s, 31)
    SanitizeSheetName = s
End Function

Function SheetExists(sheetName As String, wb As Workbook) As Boolean
    Dim t As Worksheet
    On Error Resume Next
    Set t = wb.Worksheets(sheetName)
    SheetExists = Not t Is Nothing
    On Error GoTo 0
End Function

Function UniqueName(baseName As String, wb As Workbook) As String
    Dim name As String: name = SanitizeSheetName(baseName)
    Dim i As Long: i = 1
    Do While SheetExists(name, wb)
        i = i + 1
        name = SanitizeSheetName(baseName & "_" & CStr(i))
    Loop
    UniqueName = name
End Function
VB
  • ポイント:
    • 禁止文字対応: : / \ ? * [ ]を_に置換。
    • 31文字上限: 超過は切り詰め。空なら「Sheet」。
    • 重複回避: 同名があれば連番を付けてユニーク化。

接頭辞・接尾辞を付けて一括変更

Sub RenameSheets_WithPrefixSuffix()
    Dim ws As Worksheet
    Dim prefix As String: prefix = "部門_"
    Dim suffix As String: suffix = "_2025"
    Dim newName As String

    For Each ws In ThisWorkbook.Worksheets
        newName = prefix & ws.Name & suffix
        ws.Name = UniqueName(newName, ThisWorkbook)
    Next
End Sub
VB
  • ポイント:
    • 既存名を活かす: 元名の前後に文字列を追加。
    • 安全命名: 毎回UniqueNameで重複エラーなし。

セル一覧から一括変更（選択範囲・1行/1列）

選択セルの値を新しいシート名にする（枚数分だけ）

Sub RenameSheets_FromSelection()
    Dim rng As Range, cell As Range, i As Long, ws As Worksheet
    If TypeName(Selection) <> "Range" Then
        MsgBox "セル範囲を選択してください。": Exit Sub
    End If
    Set rng = Selection

    i = 1
    For Each cell In rng.Cells
        If i > ThisWorkbook.Worksheets.Count Then Exit For
        Set ws = ThisWorkbook.Worksheets(i)
        ws.Name = UniqueName(CStr(cell.Value), ThisWorkbook)
        i = i + 1
    Next
End Sub
VB
  • ポイント:
    • 手早い: 表の一覧をそのままシート名に。
    • 枚数調整: シート数を超えたら終了。

見出しシートに一覧がある場合（例：コントロールシートのA2:A100）

Sub RenameSheets_FromListOnControl()
    Dim ctrl As Worksheet, ws As Worksheet
    Dim lastRow As Long, i As Long, nameVal As String

    Set ctrl = ThisWorkbook.Worksheets("Control") '一覧を持つシート名
    lastRow = ctrl.Cells(ctrl.Rows.Count, "A").End(xlUp).Row

    i = 1
    For i = 2 To lastRow 'A2から下
        nameVal = CStr(ctrl.Cells(i, "A").Value)
        If i - 1 <= ThisWorkbook.Worksheets.Count Then
            Set ws = ThisWorkbook.Worksheets(i - 1)
            ws.Name = UniqueName(nameVal, ThisWorkbook)
        Else
            Exit For
        End If
    Next i
End Sub
VB
  • ポイント:
    • 柔軟: 任意の一覧シートから読み込んで適用。
    • ズレ防止: 1行目は見出しとしてスキップ。

置換で一括変更（「売上」を「Sales」に）

Sub RenameSheets_Replace()
    Dim ws As Worksheet
    Dim findText As String: findText = "売上"
    Dim replText As String: replText = "Sales"
    Dim newName As String

    For Each ws In ThisWorkbook.Worksheets
        newName = Replace(ws.Name, findText, replText, 1, -1, vbTextCompare)
        If newName <> ws.Name Then
            ws.Name = UniqueName(newName, ThisWorkbook)
        End If
    Next
End Sub
VB
  • ポイント:
    • 部分一致置換: vbTextCompareで大文字小文字を無視。
    • 変更がある場合のみ: 無駄な再命名を避ける。

日付や連番を動的に付ける

先頭に年月を付与

Sub RenameSheets_AddYearMonthPrefix()
    Dim ws As Worksheet, ym As String
    ym = Format(Date, "yyyy-mm") & "_"
    For Each ws In ThisWorkbook.Worksheets
        ws.Name = UniqueName(ym & ws.Name, ThisWorkbook)
    Next
End Sub
VB

全シートを連番＋元名で整形

Sub RenameSheets_NumberingWithBase()
    Dim ws As Worksheet, i As Long, base As String
    i = 1
    For Each ws In ThisWorkbook.Worksheets
        base = ws.Name
        ws.Name = UniqueName(Format(i, "00") & "_" & base, ThisWorkbook)
        i = i + 1
    Next
End Sub
VB
  • ポイント:
    • 視認性アップ: 年月や連番を付けると並びがわかりやすい。
    • 運用しやすい: レポート、週報などの管理に最適。

実務の落とし穴と対策

  • 禁止文字・長さ上限:
    • 対策済み: SanitizeSheetNameを必ず通す。31文字上限は先に切り詰め。
  • 重複名エラー:
    • 連番付与: UniqueNameで既存を検知し、末尾に連番を追加して回避。
  • 対象の範囲:
    • Worksheetsを使用: グラフシートを含めない場合はWorksheetsに限定すると安全。
  • 順番依存の不具合:
    • インデックス参照の慎重さ: リネーム中にインデックスを使うと混乱しやすい。基本はFor Eachで安定させる。

例題で練習

例題1：部署リストから一括命名（Control!A2:A）

Sub Example_DepartmentRename()
    Dim ctrl As Worksheet, ws As Worksheet
    Dim r As Long, last As Long, nm As String

    Set ctrl = ThisWorkbook.Worksheets("Control")
    last = ctrl.Cells(ctrl.Rows.Count, "A").End(xlUp).Row

    r = 2
    For Each ws In ThisWorkbook.Worksheets
        If r > last Then Exit For
        nm = ctrl.Cells(r, "A").Value
        ws.Name = UniqueName(nm, ThisWorkbook)
        r = r + 1
    Next
    MsgBox "部署名で一括変更しました。"
End Sub
VB
  • ポイント:
    • 一覧連動: 部署リストが増減しても自動で対応。
    • 安全命名: すべてUniqueName経由。

例題2：「-draft」を削除して正式名に

Sub Example_RemoveDraftSuffix()
    Dim ws As Worksheet, newName As String
    For Each ws In ThisWorkbook.Worksheets
        newName = Replace(ws.Name, "-draft", "", 1, -1, vbTextCompare)
        If newName <> ws.Name Then
            ws.Name = UniqueName(newName, ThisWorkbook)
        End If
    Next
    MsgBox "ドラフト表記を外しました。"
End Sub
VB
  • ポイント:
    • 置換一括: 下書き表記を一掃して納品版へ。

次の一歩（小課題）

  • 課題1: InputBoxで接頭辞を入力させ、全シートに付与しつつ重複回避する。
  • 課題2: Controlシートに「旧名」「新名」を2列で並べ、対応表に基づいて一括リネームする。
  • 課題3: 一括変更前後の名前一覧をログシートに書き出し、変更履歴を残す。

スポンサーリンク
タイトルとURLをコピーしました