月次・部署別にシートが増え続けるブックを、追加・色分け・ジャンプで捌く3つのマクロ

タグ: Excel VBA 業務効率化 Tips 初心者
投稿先: Qiita

---

シートが増えるほど「探す時間」が増えていく

月次レポートや部署別の集計ブックは、運用しているうちにシートがどんどん増えていきます。4月、5月、6月……と積み重なり、気づけば数十枚。目的のシートを見つけるのに毎回タブをスクロールして目を凝らす、という人も多いはずです。今回は、こうしたブックを「追加する」「見分ける」「移動する」の3段階で楽にする実マクロを紹介します。

1. 新しい月のシートを追加する — AddNewSheet

まず月が変わったら、新しいシートを1枚追加するところから始まります。

Sub AddNewSheet()
    Dim ws As Worksheet
    Dim sheetName As String
    Dim i As Long

    On Error GoTo ErrorHandler

    sheetName = InputBox("作成するシート名を入力してください:", "新規シート作成")

    If sheetName = "" Then
        MsgBox "キャンセルされました。", vbInformation
        Exit Sub
    End If

    For Each ws In Worksheets
        If ws.Name = sheetName Then
            MsgBox "「" & sheetName & "」は既に存在します。", vbExclamation
            Exit Sub
        End If
    Next ws

    Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    ws.Name = sheetName

    MsgBox "「" & sheetName & "」を作成しました。", vbInformation
    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub

実行するとシート名を聞かれ、入力した名前で末尾に新規シートが作られます。「2026-10」のように年月を名前にしておけば、後で見返したときにも並び順がそのまま時系列になります。重複チェックが入っているので、うっかり同じ月のシートを二重に作ってしまう心配もありません。

2. タブに色をつけて一目で状態を分かるようにする — ColorSheetTabs

シートが増えてくると、名前だけでは「今月は入力済みか」「どの部署のシートか」がぱっと見で分かりにくくなります。そこでタブに色をつけます。

Sub ColorSheetTabs()
    Dim ws As Worksheet
    Dim sheetName As String
    Dim colorList As String
    Dim colorCode As Long
    Dim selectedColor As String

    On Error GoTo ErrorHandler

    sheetName = InputBox("色を設定するシート名を入力:", "タブ色設定", ActiveSheet.Name)

    If sheetName = "" Then
        Exit Sub
    End If

    On Error Resume Next
    Set ws = Worksheets(sheetName)
    On Error GoTo ErrorHandler

    If ws Is Nothing Then
        MsgBox "「" & sheetName & "」は存在しません。", vbExclamation
        Exit Sub
    End If

    colorList = "色を選択してください:" & vbCrLf & _
                "1: 赤" & vbCrLf & _
                "2: 緑" & vbCrLf & _
                "3: 青" & vbCrLf & _
                "4: 黄" & vbCrLf & _
                "5: 紫" & vbCrLf & _
                "6: 橙" & vbCrLf & _
                "7: 灰" & vbCrLf & _
                "8: 黒" & vbCrLf & _
                "0: 色なし"

    selectedColor = InputBox(colorList, "タブ色設定", "1")

    Select Case selectedColor
        Case "1": colorCode = RGB(255, 0, 0)
        Case "2": colorCode = RGB(0, 176, 80)
        Case "3": colorCode = RGB(0, 112, 192)
        Case "4": colorCode = RGB(255, 192, 0)
        Case "5": colorCode = RGB(112, 48, 160)
        Case "6": colorCode = RGB(255, 102, 0)
        Case "7": colorCode = RGB(166, 166, 166)
        Case "8": colorCode = RGB(0, 0, 0)
        Case "0": colorCode = xlColorIndexNone
        Case Else
            MsgBox "無効な選択です。", vbExclamation
            Exit Sub
    End Select

    ws.Tab.Color = colorCode

    If selectedColor = "0" Then
        MsgBox "「" & sheetName & "」のタブ色をリセットしました。", vbInformation
    Else
        MsgBox "「" & sheetName & "」のタブ色を設定しました。", vbInformation
    End If
    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub

色の割り当てルールは自由に決められます。たとえば「進行中は黄、完了は緑、要確認は赤」のようにステータス別に使えば、タブを横目で見ただけで未処理のシートが分かります。部署別ブックなら、部署ごとに固定の色を決めておくと、担当者ごとの持ち分がひと目で区別できます。

3. 目的のシートに直接ジャンプする — NavigateToSheet

シートが10枚、20枚と増えてくると、タブをスクロールして探すだけで地味に時間を食います。番号でも名前でも指定できるジャンプ用マクロを用意しておくと、この手間がなくなります。

Sub NavigateToSheet()
    Dim ws As Worksheet
    Dim sheetList As String
    Dim sheetName As String
    Dim i As Long

    On Error GoTo ErrorHandler

    sheetList = "移動先のシート名を入力:" & vbCrLf & vbCrLf
    For i = 1 To Worksheets.Count
        sheetList = sheetList & "  " & i & ": " & Worksheets(i).Name & vbCrLf
    Next i

    sheetName = InputBox(sheetList, "シート移動", "")

    If sheetName = "" Then
        Exit Sub
    End If

    If IsNumeric(sheetName) Then
        i = CLng(sheetName)
        If i >= 1 And i <= Worksheets.Count Then
            Worksheets(i).Select
            MsgBox "「" & Worksheets(i).Name & "」に移動しました。", vbInformation
        Else
            MsgBox "無効な番号です。", vbExclamation
        End If
    Else
        On Error Resume Next
        Set ws = Worksheets(sheetName)
        On Error GoTo ErrorHandler

        If ws Is Nothing Then
            MsgBox "「" & sheetName & "」は存在しません。", vbExclamation
        Else
            ws.Select
            MsgBox "「" & sheetName & "」に移動しました。", vbInformation
        End If
    End If
    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub

実行するとその場でシート一覧が表示され、番号か名前のどちらかを入力するだけで目的のシートがアクティブになります。全シートの一覧をそのまま見せてくれるので、何枚あるブックでも「今どんなシートがあるか」を忘れていても困りません。

まとめ: 「増える」「見分ける」「飛ぶ」の3点セットで運用を楽にする

月次・部署別に積み上がっていくシートは、放っておくと管理コストがじわじわ増えていきます。新規シートの追加を定型化し、色でステータスを可視化し、名前か番号でジャンプできるようにしておくだけで、シートが何十枚になっても「どこに何があるか分からなくなる」状態を避けられます。3つとも単体で使える小さなマクロなので、今使っているブックに1つずつ組み込んでみてください。

紹介した3つを含む、VBAマクロを100本、サイトにまとめて公開しています。