VBAノック86本目：全シートの総当たり表を作成

Excel&VBA解説サイト「エクセルの神髄」様出題の問題集、
「VBA100本ノック」に対する私の回答と解説のページです。

100本ノックの出題リストはこちらから
excel-ubara.com

出題：全シートの総当たり表を作成
ソースコード
- メインモジュール
- 汎用関数モジュール
解説

出題：全シートの総当たり表を作成

#VBA100本ノック 86本目
シートの先頭に「相関表」シートを挿入します。
「相関表」以外の全シートの総当たり表（マトリックス表）を作成してください。
B2セルを起点にして縦横にシート名を配置し、画像を参考に罫線を引き、文字配置(表全体を中央)してください。
※この問題は次問題と連作です。

シートの総当たり表

◇ 出題ページはこちら

ソースコード

メインモジュール

Option Explicit

Const ShName相関表 = "相関表"
Const Adrs相関表_左上セル = "B2"

' 100本ノック086：全シートの総当たり表を作成
Sub ★シートの総当たり表をアクティブブックの先頭に挿入する()

    Dim wb対象ブック As Workbook: Set wb対象ブック = ActiveWorkbook

    ' すでに相関表シートがあればExit
    If Isシートが存在する(ShName相関表, wb対象ブック) Then
        MsgBox "すでに相関表が存在するブックです。削除してから実行してください。"
        Exit Sub
    End If

    ' メインプロシージャを実行
    Call シートの総当たり表を指定ブック先頭に挿入する(wb対象ブック)

End Sub

' メインプロシージャ
Sub シートの総当たり表を指定ブック先頭に挿入する(wb対象ブック As Workbook)

    ' 新規シートを対象ブックの先頭に挿入
    Dim ws出力シート As Worksheet
    Set ws出力シート = wb対象ブック.Worksheets.Add
    ws出力シート.Move before:=wb対象ブック.Worksheets(1)
    ws出力シート.Name = "相関表"

    Dim 相関表左上セル As Range: Set 相関表左上セル = ws出力シート.Range(Adrs相関表_左上セル)

    ' 対象ブックの全シート名を相関表に出力
    Dim シートNo As Long
    For シートNo = 2 To wb対象ブック.Worksheets.Count
    
        相関表左上セル.Cells(シートNo, 1).NumberFormatLocal = "@"
        相関表左上セル.Cells(シートNo, 1) = wb対象ブック.Worksheets(シートNo).Name
        相関表左上セル.Cells(1, シートNo).NumberFormatLocal = "@"
        相関表左上セル.Cells(1, シートNo) = wb対象ブック.Worksheets(シートNo).Name

    Next
    
    ' 各種書式設定
    Dim 相関表エリア As Range: Set 相関表エリア = 相関表左上セル.CurrentRegion
    
    ' 文字のセンタリング
    相関表エリア.HorizontalAlignment = xlCenter
    相関表エリア.VerticalAlignment = xlCenter
    
    ' 格子罫線
    相関表エリア.Borders.LineStyle = xlContinuous

    ' 斜め罫線
    Dim i As Long
    For i = 1 To 相関表エリア.Rows.Count
        相関表エリア.Cells(i, i).Borders(xlDiagonalDown).LineStyle = xlContinuous
    Next
    
    ' 列幅（全シートがある第1列をAutoFitして全列へ反映
    相関表エリア.Cells(1, 1).EntireColumn.AutoFit
    相関表エリア.EntireColumn.ColumnWidth = 相関表エリア.Cells(1, 1).EntireColumn.ColumnWidth

End Sub

汎用関数モジュール

' シートの存在判定
' 参考：https://www.limecode.jp/entry/utility/existsworksheet
Function Isシートが存在する(判定シート名 As String, 指定ブック As Workbook) As Boolean

    ' ブック内の全シートを走査
    Dim ws As Worksheet
    For Each ws In 指定ブック.Worksheets

        ' シート名が一致したらTrueを返してExit
        If ws.Name = 判定シート名 Then
            Isシートが存在する = True
            Exit Function
        End If

    Next

End Function