Excel シートを管理するマクロ集

Excel シートの管理に役立つマクロ集

今回は、Excel のワークシート管理に役立つ（かもしれない）マクロをいくつか公開します。 シートへのハイパーリンクを活用して、シートの一覧、追加、名前変更、複製、並べ替えなどを実現しています。

増えたシートを整理したい

Excel はシートを管理する機能が貧弱でしかも使い勝手がよくありません。

ワークシートの追加、削除、複製、移動、シート名の変更など、基本操作はシートタブから個別に行うことはできるのですが、手作業で整理するのは煩雑でイライラします。

ワークブック内のシート全体に対して一括で管理するような機能がないのはなぜなのでしょうか。 本来なら、リボンにシート管理用の「シート」タブがあってもいいくらいの重要な機能だと思うのですが、まあ、文句を言っても仕事は終わりません。

シート管理的に効果的なショートカットや裏技があるのではないかと色々調べたのですが、調べても調べてもマシな方法が見つかりませんでした。

もうそこは諦めて、シート管理用のマクロをいくつか作成することにしました。 まとめて今回公開することにします。

マクロを使われない方には、今回お役立ち情報がなくてすみません。

シート管理のマクロ集

以下に紹介するマクロは、「ハイパーリンク」を活用したセル操作ベースでのワークシート管理機能を実現しています。

作業の流れとしては、まず作業用の新規ワークシートにリンク付きシート名一覧を用意し、これを「目次シート」とします。 この目次シート上でリンクセルに対して行った変更内容がマクロでリンク先ワークシートへ反映されるイメージです。

1. シートの一覧を作成する
2. シートの名前を変更する
3. シートを新規追加する
4. シートをコピーする
5. シートを並べ替える
6. シートを複数選択する

「シートを削除する」マクロはあえて用意しません。 シートの削除は、間違えたときに取り返しがつかないので事故になるリスクを避けるためと、シートタブからの削除操作でも特に不便はないと考えるからです。

本マクロの VBA プログラムは、コピペ用としてはちょっと長いのですが、記事の最後にまとめておきます。

• シート管理マクロ VBA プログラム

1. シートの一覧を作成する

【概要】

「シートの一覧作成_リンク付き」マクロは、リンク付きシート名の一覧を自動で作成できます。

【使い方】

目次シートでこのマクロを実行すると、既存シートへのリンクセルのリストがセル位置からタテに展開されます。 シート名の青リンクをクリックするとリンク先のワークシートへジャンプすることができます。

【説明】

一覧への展開対象となるシート名は、ワークシートの全てではありません。 シート管理としての使い勝手の都合上、対象シートを目次シートより「後ろ（右方向）」にあるワークシートに限定し、「前（左方向）」のシートは含まないようにしています。 また目次シート自体も対象外です。

特定のワークシートを指定して、そのリンクセルのみを作成することも可能です。 目次シートと一緒に任意のシートを複数選択してマクロを実行すれば、 選択シートのみのリンクセルが作成されます。 ワークシートを複数選択するには、Shift キー（範囲選択）や Ctrl キー（追加選択）を押しながら、対象となるシート見出しタブをクリックしていきます。

また、「非表示」状態になっているワークシートも、もし範囲にあれば一覧に追加されます。 非表示シートでは区別できるように青リンクの色が薄めとなり、クリックしてもジャンプすることはありません。

ちなみに、クリックでジャンプしたワークシートから目次シートに素早く戻るには、移動直後なら Ctrl+G ⇒ Enter が使えます。 また、目次シートに簡単な「名前」 （m など）を付与しておけば、名前ボックスからいつでもすぐに戻れるようになります。

2. シート名を変更する

青リンクのシート名は通常のテキストと同様に編集することができ、変更後はシート名の別名として扱うことが出来ます。

リンク名が別名であるかどうかは、マウスカーソルを青リンクの上にかざせば（ホーバー）、リンク先シート名が表示されるので確認できます。。

青リンクがシート名と一致しない別名になっているとき、これを「別名リンク」と呼ぶことにします。

【概要】

「シートの名前変更」マクロは、別名リンクとなっているリンクセルから、リンク先のシートの名前を別名のシート名で変更します。

つまり、ハイパーリンクを更新するのではなく、ワークシート自体の名前を変更します。

【使い方】

青リンクを別の名前に編集した上で、セルを選択状態にしてこのマクロを実行すると、その名前がリンク先シートに自動で反映されます。 青リンクをクリックしてジャンプするシートは同じですが、見出しタブの名前が変わっているのが確認できるはずです。

また、別名リンクを複数選択すればシート名の一括変更も可能です。 その場合、変更したリンクだけを選んで選択しなくても、一覧全体を範囲選択したままマクロを実行して問題ありません。 リンク名が一致しているセルにはなにも変更されず、ただのテキストセルや空のセルは単純に無視されるからです。

【説明】

シート間のセル参照は、本マクロでシート名を変更しても参照切れにはなりません。

リンクセルの編集は、うかつに青リンクをクリックするとジャンプしてしまいますので注意が必要です。 ジャンプを防ぐには、青リンクを避けてセルの余白をクリックする必要があります。 それが難しいセルでは、マウスで青リンクを長押しするか、矢印キーで隣のセルから移動後 F2 キーを押すことてセル編集モードに入ることができます。

元々リンク先のシートが存在しない「リンク切れ」のセルでは、ハイパーリンクが解除され、ただのテキストセルとなります。 また、同じシートへの別名リンクが複数含まれていた場合、最初のセルの別名のみが採用されます。 結果、残りのセルではリンク切れとなるのでハイパーリンクも解除されでしょう。

3. シートを新規追加する

新規シートを追加するのは難しいことではありませんが、たくさん追加した後いちいち見出しタブに名前を入力していくのは非効率な作業です。

【概要】

「シートの新規追加」マクロは、シート名のリストから新規ワークシートを追加します。

【使い方】

追加したいシート名のリストを選択してこのマクロを実行すると、シート名を付けた新規ワークシートが一括で追加されます。 元のシート名リストはリンク付き目次になります。

【説明】

もしその中に既存のシート名があっても重複エラーにはなりません。

それは、新規シートを任意の位置に「挿入」できるようにするのに都合がいいからです。たとえば、既存のシート一覧の途中にシート名を挿入したときに、あえて直前のシート名をセル範囲選択に含めてこのマクロを実行することで、新規ワークシートが挿入される位置関係を指定できるようになっています。

元からあったリンクセルや空欄のセルは無視されるためセル範囲に含めても問題ありませ ん。

4. シートをコピーする

Excel 文書作成の効率化には、過去のシートをテンプレートとしてうまく使いまわしすることが重要です。

【概要】

「シートのコピー」マクロは、リンクセルのリンク先シートをコピーします。

【使い方】

リンクセルを選択してこのマクロを実行すると、リンク先のシートの複製がブックに追加され、リンク先とリンク名が新たに更新されます。

基本は、コピーしたいシートのリンクセルの方を一覧から範囲選択でコピー＆ペーストし、そのまま貼り付け先のセル範囲に対してこのマクロを実行するという操作になると思います。

テンプレート的シートのような一種類のシートでも、リンクセルを必要なだけコピー＆ペーストしてからマクロを実行すれば、何枚でも一括で複製出来ます。

【説明】

複製されたシートの名前はオリジナルに連番を付与したものになるので、そのままセルのリンク名を適宜変更して「シートの名前変更」マクロを適用するなどして整理してください。

元のリンク先のシートが存在しない「リンク切れ」の場合は、シートを追加せず、セルのリンクも削除されます。

別のワークブックへのコピーはできません。

5. シートを並べ替える

シート名を月次や部署名でソートするなど、シートを並び替えこともしばしばあるかと思いますが、シート見出しタブを手作業で移動して並び替えるの本来人間のやる仕事ではありません。

【概要】

「シートの並べ替え」マクロは、シート名一覧の順番でシートを並べ替えます。

【使い方】

まず目次シートでシート名一覧の行を入れ替えたり、Excelの「並べ替え」や「フィルター」を使ってソートしておきます。 並べ替えたセル範囲を選択してこのマクロを実行すると、シート名一覧の並び順に従ってワークシートシートを並べ替えられます。

【説明】

このときシート名は必ずしもリンクセルである必要はなく、存在するシート名ならテキストセルでもOKです。

セルの並び順は、セル範囲の選択順にも従いますので、一部のシートだけを移動したいときに便利です。 たとえば特定のシート名だけ Ctrl+クリック で選択していけば、クリックした順番でそのシートが前の方に集められるので、編集中のシートだけ一時的に前に寄せたいというときに使えます。 この方法ならシート名一覧を並び替えなくても済むので、元の順番に戻したくなったら一覧全体を選択して再度マクロを実行するだけです。

空欄セルや存在しないシート名は単に無視されます。

6. シートを複数選択する

Excel 機能によるシート操作には、なによりもシート選択が必要ですが、シート見出しをスクロールしながら対象シートを選択していくのは面倒です。

【概要】

「シートの複数選択」マクロは、目次で選択されたシートを一括で選択します。

【使い方】

目次シートの一覧からシート名を範囲選択あるいは個別複数選択してからこのマクロを実行すると、そのシートが選択状態になります。 目次シート自体は除外されます。

【説明】

シート名は必ずしもリンクセルである必要はなく、存在するシート名ならテキストセルでもOKです。

Excel 機能の移動・コピー・削除などで複数シートを一括で処理したいときに使用できます。

---

---

シート管理マクロ VBA プログラム

Option Explicit

Sub シートの一覧作成_リンク付き()
    If TypeName(Selection) <> "Range" Then Beep: Exit Sub
    
    Dim shts As Sheets
    If 1 < ActiveWindow.SelectedSheets.Count Then
        Set shts = ActiveWindow.SelectedSheets
        ActiveSheet.Select
    Else
        Set shts = Sheets(intRange(ActiveSheet.Index, Sheets.Count))
    End If
    
    Dim anch As Range
    Set anch = Selection.Cells(1)
    anch.Resize(shts.Count).NumberFormat = "@"
    Dim sht As Object
    For Each sht In shts
        If TypeName(sht) = "Worksheet" And Not sht Is ActiveSheet Then
            setSheetLink anch, sht
            Set anch = anch.Offset(1)
        End If
    Next
End Sub

Sub シートの名前変更()
    If TypeName(Selection) <> "Range" Then Beep: Exit Sub
    On Error GoTo finish
    Dim shtName As String
    
    Dim wsht As Worksheet
    Dim anch As Range
    For Each anch In Selection.Cells
        shtName = anch.Text
        Set wsht = findWorksheet(getLinkSheetName(anch), Worksheets)
        If wsht Is Nothing Then
            anch.Hyperlinks.Delete
        ElseIf wsht.Visible Then
            wsht.Name = shtName
            setSheetLink anch, wsht
        End If
    Next
    
finish:
    If Err.Number <> 0 Then
        MsgBox "シート名「" & shtName & "」を作成できませんでした。処理を中断します。" & vbCrLf & Err.Description
    End If
End Sub

Sub シートの新規追加()
    If TypeName(Selection) <> "Range" Then Beep: Exit Sub
    On Error GoTo finish
    Application.ScreenUpdating = False
    Dim shtName As String
    Dim mokuji As Worksheet
    Set mokuji = ActiveSheet
    
    Dim wsht As Worksheet
    Dim anch As Range
    For Each anch In Selection.Cells
        shtName = anch.Text
        If shtName <> "" Then
            Set wsht = findWorksheet(shtName, Worksheets)
            If wsht Is Nothing Then
                Worksheets.Add(After:=ActiveSheet).Name = shtName
                setSheetLink anch, ActiveSheet
            Else
                wsht.Activate
            End If
        End If
    Next
    
finish:
    mokuji.Activate
    Application.ScreenUpdating = True
    If Err.Number <> 0 Then
        MsgBox "シート名「" & shtName & "」を作成できませんでした。処理を中断します。" & vbCrLf & Err.Description
    End If
End Sub

Sub シートのコピー()
    If TypeName(Selection) <> "Range" Then Beep: Exit Sub
    On Error GoTo finish
    Application.ScreenUpdating = False
    Dim shtName As String
    Dim mokuji As Worksheet
    Set mokuji = ActiveSheet
    
    splitHyperlinkRange Selection.Cells
    
    Dim wsht As Worksheet
    Dim anch As Range
    For Each anch In Selection.Cells
        shtName = anch.Text
        Set wsht = findWorksheet(getLinkSheetName(anch), Worksheets)
        If Not wsht Is Nothing And Not wsht Is mokuji Then
            wsht.Copy After:=ActiveSheet
            setSheetLink anch, ActiveSheet
            anch.Value = ActiveSheet.Name
        End If
    Next
finish:
    mokuji.Activate
    Application.ScreenUpdating = True
    If Err.Number <> 0 Then
        MsgBox "シート「" & shtName & "」をコピーできませんでした。処理を中断します。" & vbCrLf & Err.Description
    End If
End Sub

Sub シートの並べ替え()
    If TypeName(Selection) <> "Range" Then Beep: Exit Sub
    Application.ScreenUpdating = False
    Dim mokuji As Worksheet
    Set mokuji = ActiveSheet
        
    Dim wsht As Worksheet
    For Each wsht In collectWorksheets(Selection.Cells, Worksheets)
        wsht.Move After:=ActiveSheet
    Next
    
    mokuji.Activate
    Application.ScreenUpdating = True
End Sub

Sub シートの複数選択()
    If TypeName(Selection) <> "Range" Then Beep: Exit Sub
    
    Dim wshtColl As Collection
    Set wshtColl = collectWorksheets(Selection.Cells, Worksheets)
    If wshtColl.Count = 0 Then Beep: Exit Sub
    
    Application.ScreenUpdating = False
    Application.Goto wshtColl(1).Range("a1")
    Dim wsht As Worksheet
    For Each wsht In wshtColl
        If wsht.Visible Then
            wsht.Select False
        End If
    Next
    wshtColl(1).Activate
    Application.ScreenUpdating = True
End Sub

Private Sub setSheetLink(ByVal anch As Range, sht As Worksheet)
    Dim shtName As String
    shtName = Replace(Replace(sht.Name, "'", "''"), "’", "’’")
    If IsEmpty(anch) Then anch.Value = sht.Name
    anch.Hyperlinks.Delete
    anch.Hyperlinks.Add anch, "", "'" & shtName & "'!A1", sht.Name
    anch.Font.TintAndShade = IIf(sht.Visible, 0, 0.5)
End Sub

Private Function findWorksheet(shtName As Variant, inSheets As Sheets) As Worksheet
    If shtName = "" Then Exit Function
    On Error Resume Next
    Set findWorksheet = inSheets(shtName)
    If TypeName(findWorksheet) <> "Worksheet" Then Set findWorksheet = Nothing
    Err.Clear
End Function

Private Function collectWorksheets(ByVal linkCells As Range, shts As Sheets) As Collection
    Set collectWorksheets = New Collection
    Dim shtName As Variant
    Dim wsht As Worksheet
    Dim anch As Range
    For Each anch In linkCells
        For Each shtName In Array(getLinkSheetName(anch), anch.Text)
            Set wsht = findWorksheet(shtName, shts)
            If Not wsht Is Nothing Then
                collectWorksheets.Add wsht
                Exit For
            End If
        Next
    Next
End Function

Private Function getLinkSheetName(anch As Range) As Variant
    If anch.Hyperlinks.Count = 0 Then Exit Function
    If anch.Hyperlinks(1).Address <> "" Then Exit Function
    With CreateObject("VBScript.RegExp")
        .Pattern = "^('?)(.+)\1!.+?$"
        getLinkSheetName = .Execute(anch.Hyperlinks(1).SubAddress)(0).Submatches(1)
    End With
    getLinkSheetName = Replace(Replace(getLinkSheetName, "''", "'"), "’’", "’")
End Function

Private Sub splitHyperlinkRange(ByVal rng As Range)
    Dim wshts As Sheets
    Set wshts = rng.Parent.Parent.Worksheets
    Dim cur As Range
    For Each cur In rng.Cells
        If 0 < cur.Hyperlinks.Count Then
            If 0 < cur.Hyperlinks(1).Range.Count Then
                Dim wsht As Worksheet
                Dim anchs As Range
                With cur.Hyperlinks(1)
                    Set wsht = findWorksheet(getLinkSheetName(.Range), wshts)
                    Set anchs = .Range.Cells
                    .Delete
                End With
                If Not wsht Is Nothing Then
                    Dim anch As Range
                    For Each anch In anchs
                        setSheetLink anch, wsht
                    Next
                End If
            End If
        End If
    Next
End Sub

Private Function intRange(ByVal a As Integer, ByVal b As Integer) As Integer()
    Dim arr() As Integer
    ReDim arr(a To b)
    For a = a To b
        arr(a) = a
    Next
    intRange = arr
End Function

【使い方】

1. VBE で新規モジュールを作成し、上記VBAプログラムをコピー＆ペーストします
   • シート管理対象とは別の新規ワークブックにマクロを置くことをお勧めします
2. 目次シートを用意し任意のセル・セル範囲を選択ます
   • 目次シートは管理対象のワークブック内にある必要があります
3. 目的の操作マクロを実行します

注意点として、Excelのシート名は全角英数記号と半角英数記号を区別しません。 期待通りの結果にならなかったり、シート名でエラーになったときには、全角と半角が混在していないかご確認ください。

作業用に追加した目次シートは削除してかまいません。 もちろん、本当の目次として残して、運用に使われてるのも問題ありません。

【注意】 本マクロの実行結果は、「元に戻す(Undo)」することができません。 あらかじめ Excel ファイルのバックアップを取っておくことをお勧めします。

【免責】 本マクロの不具合、誤操作等による、いかなる損失・損害の責任も負いかねますのであらかじめご了承ください。

【変更履歴】
[2019/02/25] シートの新規追加で空セルがエラーになっていたのを修正しました。
[2019/02/25] シート名にシングルクオートがあるとリンク切れとなる不具合を修正しました。

まとめ

Excel のハイパーリンクを活用してシート管理するマクロを作成しました。

定形の文書、分析データ、テストのエビデンス、マスタ管理など、シート数が増えすぎて困った Excel ブックの整理する時に使用してみてください。

機能を欲張ったため、約200行（！）という超大作になりました（これでもだいぶ削ったのです）。 個人ブログからコピペして使うには躊躇する分量かもしれません。 操作性や安定性などが信用できるまでは、いきなり業務で使用中の Excel 文書で操作せずに、お試しでしばらく使いこんで確認してみてからの方がいいでしょう。

本マクロは、Windows 10 の Excel 2013 で動作確認しました。 2019 など新しい Excel でもちゃんと動くのかはまだ試せていいませんが、たぶん大丈夫です。 使ってみた方でもし不具合・改善点などあればコメントでお知らせください。

関連記事

www.shegolab.jp

www.shegolab.jp

変更履歴

• [2019/02/25] マクロ修正（シートの新規追加で空セルがエラーになっていたのを修正）
• [2019/02/25] マクロ修正（シート名にシングルクオートがあるとリンク切れとなる不具合を修正）
• [2023/01/02] ページ内リンクを一部修正