Excelのワークシートに便利な目次シートを作成する方法を共有します。目次シートには各シートへのハイパーリンクが追加され、シート間のナビゲーションが簡単に行えます。
以下の手順でVBAコードを使用して目次シートを作成します。
Excelを開き、目次を作成したいワークブックを開きます。
VBE（Visual Basic for Applicationsエディタ）を開きます。キーボードの「Alt」キーと「F11」キーを同時に押すか、Excelのリボンの「開発」タブを選択し、「Visual Basic」ボタンをクリックします。※「開発」タブが表示されていない場合は、ファイル > オプション > カスタマイズリボンで「開発」にチェックを入れてください。
VBEが開かれたら、左上の「挿入」メニューをクリックし、「モジュール」を選択して新しいモジュールを作成します。
新しいモジュールが開かれたら、上記のVBAコードをコピーし、モジュール内に貼り付けます。
VBEのメニューから「ファイル」>「閉じて戻る」をクリックして、VBEを閉じます。
Excelに戻り、開発タブの「マクロ」ボタンをクリックします。マクロの一覧に「View_目次作成M」が表示されるはずです。
「View_目次作成M」を選択し、「実行」ボタンをクリックします。これにより、VBAが実行され、目次シートが作成されます。
以上の手順で、VBAを使用してExcelの目次シートを作成できます。目次シートには各シートへのハイパーリンクが追加され、シート間のナビゲーションが容易になります。作業効率が向上し、非常に便利です。処理速度の改善点があれば、ご意見をいただけると幸いです。みなさんでより良い目次シート作成方法を共有しましょう！
ソースコード：
' 拡大率の定数
Const magnification = 75
' 目次シートを作成するサブプロシージャ
Sub View_目次作成M()
' 変数の宣言
Dim sheetCount As Integer
Dim worksheetName As String
Dim Worksheet As Worksheet
Dim col_num As Integer
col_num = 1
Dim j As Integer
row_num = 1
' INDEXシートが存在した場合は削除
If ExistsWorksheet("INDEX") Then
Worksheets("INDEX").Select
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
End If
' 新しいシートを追加し、名前を"INDEX"に設定
Worksheets.Add
ActiveSheet.name = "INDEX"
' アプリケーションの設定を一時的に無効にする
accelerate
' 各シートに対して目次を作成
For i = 1 To Worksheets.count
worksheetName = Worksheets(i).name
If Mid(worksheetName, 1, 1) = "【" Or Mid(worksheetName, 1, 1) = "★" Then
row_num = 1
col_num = col_num + 1
End If
' ハイパーリンクの作成
Dim subAddress_ As String
subAddress_ = "'" & worksheetName & "'" & "!" & Worksheets(i).Cells(1, 1).Address
' セルをアクティブにし、ハイパーリンクを追加
Worksheets("INDEX").Cells(row_num, col_num).Activate
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=ActiveWorkbook.FullName, SubAddress:=subAddress_
ActiveCell.Value = worksheetName
Cells(row_num, col_num) = Worksheets(i).name
Cells(row_num, col_num).Interior.colorIndex = Worksheets(i).Tab.colorIndex
Cells(row_num, col_num).EntireColumn.ColumnWidth = 30
row_num = row_num + 1
Next i
' アプリケーションの設定を元に戻す
clearAccelerate
' 列幅の調整
Columns("B:BB").ColumnWidth = 10
Columns("A:A").EntireColumn.AutoFit
Cells.EntireColumn.AutoFit
Cells(1, 1).Select
' フリーズパンを設定
FreezePanes
File_time_series_
' ズームの設定
For i = 1 To Worksheets.count
Worksheets(i).Select
ActiveWindow.zoom = magnification
Next i
Worksheets(1).Select
End Sub
' セルをフリーズパンするサブプロシージャ
Sub FreezePanes()
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
End Sub
' シートが存在するかどうかを判断する関数
Function ExistsWorksheet(ByVal name As String)
Dim ws As Worksheet
For Each ws In sheets
If ws.name = name Then
ExistsWorksheet = True
Exit Function
End If
Next
ExistsWorksheet = False
End Function
' アプリケーションの設定を一時的に無効にするサブプロシージャ
Sub accelerate()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
' アプリケーションの設定を元に戻すサブプロシージャ
Sub clearAccelerate()
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
