Excel VBA 逆引き集 | シート一覧を取得

Excel VBA
スポンサーリンク

シート一覧を取得

「すべてのシート名を集める」「可視だけに絞る」「配列やCollectionで受け取る」「一覧シートに書き出す」など、初心者でも迷わず使える定番パターンをコードとテンプレートでまとめます。

基本：すべてのシート名をメッセージで確認

Sub ShowAllSheetNames()
    Dim s As Object, msg As String
    For Each s In ThisWorkbook.Sheets
        msg = msg & s.Name & vbCrLf
    Next
    MsgBox msg, vbInformation, "シート一覧"
End Sub
VB
  • ポイント:
    • Sheetsで包括: グラフシートを含めて一覧化。ワークシート限定ならWorksheetsに置き換え。
    • 最短確認: まずは「取れているか」を手早く確認。

受け取り方のテンプレート：Collection／配列に格納

Collectionに格納（柔軟で扱いやすい）

Function GetSheetNames(Optional wb As Workbook, Optional onlyVisible As Boolean = False) As Collection
    Dim result As New Collection, i As Long
    If wb Is Nothing Then Set wb = ThisWorkbook
    For i = 1 To wb.Sheets.Count
        If (Not onlyVisible) Or (wb.Sheets(i).Visible = xlSheetVisible) Then
            result.Add wb.Sheets(i).Name
        End If
    Next
    Set GetSheetNames = result
End Function

Sub Example_UseCollection()
    Dim names As Collection, i As Long
    Set names = GetSheetNames(, True) '可視のみ
    For i = 1 To names.Count
        Debug.Print names(i)
    Next
End Sub
VB
  • ポイント:
    • onlyVisibleで切替: 非表示を除外したいときに便利。
    • Collection: 追加・走査が簡単で初心者向き。

配列に格納（インデックスアクセスが必要なとき）

Function GetSheetNamesArray(Optional wb As Workbook, Optional onlyVisible As Boolean = False) As Variant
    Dim tmp As Collection, arr() As String, i As Long
    Set tmp = GetSheetNames(wb, onlyVisible)
    ReDim arr(1 To tmp.Count)
    For i = 1 To tmp.Count
        arr(i) = tmp(i)
    Next
    GetSheetNamesArray = arr
End Function

Sub Example_UseArray()
    Dim arr As Variant, i As Long
    arr = GetSheetNamesArray(, False)
    For i = LBound(arr) To UBound(arr)
        Debug.Print arr(i)
    Next
End Sub
VB
  • ポイント:
    • 配列化: ワークシート関数や他APIと組み合わせる場面に向く。

一覧シートへ書き出す（よく使う定番）

Sub OutputSheetList(Optional targetName As String = "Sheet List")
    Dim out As Worksheet, s As Object, r As Long
    Set out = GetOrCreateSheet(targetName) '下のテンプレートを使用
    out.Cells.Clear
    out.Range("A1").Value = "シート名"
    out.Range("B1").Value = "種類"
    out.Range("C1").Value = "表示状態"

    r = 2
    For Each s In ThisWorkbook.Sheets
        out.Cells(r, 1).Value = s.Name
        out.Cells(r, 2).Value = IIf(TypeOf s Is Worksheet, "Worksheet", "Chart/Other")
        out.Cells(r, 3).Value = IIf(s.Visible = xlSheetVisible, "Visible", IIf(s.Visible = xlSheetHidden, "Hidden", "VeryHidden"))
        r = r + 1
    Next

    out.Columns("A:C").AutoFit
    MsgBox "一覧を '" & targetName & "' に出力しました。"
End Sub

Function GetOrCreateSheet(sheetName As String, Optional wb As Workbook) As Worksheet
    Dim ws As Worksheet
    If wb Is Nothing Then Set wb = ThisWorkbook
    On Error Resume Next
    Set ws = wb.Worksheets(sheetName)
    On Error GoTo 0
    If ws Is Nothing Then
        Set ws = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
        ws.Name = SanitizeSheetName(sheetName, wb)
    End If
    Set GetOrCreateSheet = ws
End Function

Function SanitizeSheetName(rawName As String, wb As Workbook) 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)
    '重複回避
    Dim base As String: base = s, i As Long: i = 1
    Do While SheetExists(s, wb)
        i = i + 1
        s = IIf(Len(base) > 28, Left$(base, 28), base) & "_" & CStr(i)
    Loop
    SanitizeSheetName = s
End Function

Function SheetExists(sheetName As String, Optional wb As Workbook) As Boolean
    Dim t As Worksheet
    If wb Is Nothing Then Set wb = ThisWorkbook
    On Error Resume Next
    Set t = wb.Worksheets(sheetName)
    SheetExists = Not t Is Nothing
    On Error GoTo 0
End Function
VB
  • ポイント:
    • 種類と表示状態も記録: 実務で役立つ付加情報を一緒に出すと便利。
    • 初期化と自動整形: 列幅自動調整で見やすく。

フィルタ付き取得：可視のみ・部分一致・除外指定

可視のみのシート名リスト

Function GetVisibleWorksheetNames(Optional wb As Workbook) As Collection
    Dim result As New Collection, ws As Worksheet
    If wb Is Nothing Then Set wb = ThisWorkbook
    For Each ws In wb.Worksheets
        If ws.Visible = xlSheetVisible Then result.Add ws.Name
    Next
    Set GetVisibleWorksheetNames = result
End Function
VB

部分一致で抽出（例：「売上」を含む）

Function GetSheetNamesByPartial(partial As String, Optional wb As Workbook) As Collection
    Dim result As New Collection, s As Object
    If wb Is Nothing Then Set wb = ThisWorkbook
    For Each s In wb.Sheets
        If InStr(1, s.Name, partial, vbTextCompare) > 0 Then
            result.Add s.Name
        End If
    Next
    Set GetSheetNamesByPartial = result
End Function
VB

除外名を指定して取得

Function GetSheetNamesExcept(exceptNames As Variant, Optional wb As Workbook) As Collection
    Dim keepOut As Object, s As Object
    Dim result As New Collection, i As Long
    If wb Is Nothing Then Set wb = ThisWorkbook

    Set keepOut = CreateObject("Scripting.Dictionary")
    For i = LBound(exceptNames) To UBound(exceptNames)
        keepOut(CStr(exceptNames(i))) = True
    Next

    For Each s In wb.Sheets
        If Not keepOut.Exists(s.Name) Then result.Add s.Name
    Next
    Set GetSheetNamesExcept = result
End Function
VB
  • ポイント:
    • 実務向けフィルタ: 可視限定・部分一致・除外指定の3パターンがあれば大抵の要件に対応可能。

他ブックのシート一覧を取得する

Sub OutputOtherWorkbookSheetList()
    Dim wb As Workbook, out As Worksheet, s As Object, r As Long
    Set wb = Workbooks("月次集計.xlsm") '開いているブック名を指定
    Set out = GetOrCreateSheet("Other Sheet List", ThisWorkbook)

    out.Cells.Clear
    out.Range("A1").Value = "シート名"
    r = 2
    For Each s In wb.Sheets
        out.Cells(r, 1).Value = s.Name
        r = r + 1
    Next
    out.Columns("A").AutoFit
    MsgBox "他ブックの一覧を出力しました。"
End Sub
VB
  • ポイント:
    • 対象明示: 誤操作を避けるため、どのブックの一覧かを常に明示。

例題で練習

例題1：リンク付き目次を作る（クリックでジャンプ）

Sub MakeSheetIndex()
    Dim out As Worksheet, ws As Worksheet, r As Long
    Set out = GetOrCreateSheet("Index")
    out.Cells.Clear
    out.Range("A1").Value = "目次（クリックで移動）"
    r = 2
    For Each ws In ThisWorkbook.Worksheets
        out.Hyperlinks.Add Anchor:=out.Cells(r, 1), Address:="", SubAddress:= _
            "'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
        r = r + 1
    Next
    out.Columns("A").AutoFit
End Sub
VB
  • ポイント:
    • ハイパーリンク: 実務で使える目次の自動作成。

例題2：可視ワークシートだけをCSVに順次エクスポート

Sub ExportVisibleWorksheetsToCSV()
    Dim ws As Worksheet, base As String
    base = ThisWorkbook.Path & "\"
    For Each ws In ThisWorkbook.Worksheets
        If ws.Visible = xlSheetVisible Then
            ws.Copy '新規ブックにコピー
            With ActiveWorkbook
                .SaveAs Filename:=base & ws.Name & ".csv", FileFormat:=xlCSV
                .Close SaveChanges:=False
            End With
        End If
    Next
    MsgBox "可視シートのみCSV出力しました。"
End Sub
VB
  • ポイント:
    • 一覧取得の応用: 可視フィルタと組み合わせた実務タスク。

実務の落とし穴と対策

  • WorksheetsとSheetsの違い:
    • 選び方: グラフシート等も対象ならSheets、ワークシート限定ならWorksheets。用途で統一。
  • 非表示の扱い:
    • 画面操作前: 非表示やVeryHiddenは選択不可。可視チェックかオブジェクト参照で処理する。
  • ThisWorkbookとActiveWorkbook:
    • 誤操作防止: マクロ格納ブックか操作中ブックか、対象を常に明確に。
  • 日本語名・禁止文字・31文字上限:
    • 命名時: 一覧をもとに新規作成やリネームする場合は、必ず安全化関数を挟む。

次の一歩（小課題）

  • 課題1: 可視ワークシート名だけのCollectionを作り、ログシートに縦に書き出す。
  • 課題2: 「売上」「在庫」を含むシート名だけを抽出して、新しい目次を作る。
  • 課題3: 他ブックを指定して、そのシート一覧を現在のブックに出力し、リンクで相互参照できるようにする。

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