통합 문서의 시트 이름을 가져와 목록을 만드는 엑셀 VBA

책에 있는 시트명을 취득해 일람표를 작성하는 엑셀 VBA를 소개합니다.

다음 샘플 코드를 사용하면,

파일 열기 대화 상자를 표시합니다.

시트명을 취득하고 싶은 엑셀북을 선택.

선택한 엑셀 북에, 「시트명 일람」시트를 추가.

엑셀 북에 포함되는 모든 시트명을 취득, 「시트명 일람」에 시트명의 일람표를 작성한다.

라는 작업을 자동화합니다.

조작방법

1,
아래의 샘플 코드를 포함한 엑셀 파일을 열고 →「개발」→「매크로」의 순서로 클릭.
「A 시트명 취득」→「실행」의 순서로 클릭.


2,
파일 열기 대화 상자가 표시되므로 시트 이름을 가져오려는 대상 엑셀 북을 클릭하고 열기를 클릭합니다.


3,
매크로가 실행됩니다.
「시트명 일람」을 추가, 전체 시트명을 취득해,
시트 이름 목록에 시트 이름 목록을 만듭니다.


완료입니다.

샘플 코드

Sub Aファイルを開く()
    Dim OpenFileName As String

OpenFileName = Application.GetOpenFilename("Excelファイル,*.xls*")

If OpenFileName = "False" Then

    MsgBox "キャンセルされました。処理を終了します。"

    End

Else
    Workbooks.Open OpenFileName

End If


End Sub
Sub Aシート名取得()
    Dim sh As Variant, flag As Boolean
    Dim ws As Worksheet
    Dim i As Long
    i = 0

Call Aファイルを開く


'画面更新停止
Application.ScreenUpdating = False

'確認ダイアログ停止
Application.DisplayAlerts = False

For Each sh In Sheets
    If sh.Name = "シート名一覧" Then
        flag = True
        Exit For
    End If
Next sh

If flag = True Then

    Dim rc As Integer

    'メッセージ表示
    rc = MsgBox("シート「シート名一覧」を上書きしますか？" & Chr(13) & "※この処理は戻せません", vbYesNo + vbQuestion, "確認")

    If rc = vbYes Then
        '画面更新停止
        Application.ScreenUpdating = False

        'シート選択
        Worksheets("シート名一覧").Activate

        'シート削除
        ActiveSheet.Delete

        '画面更新停止
        Application.ScreenUpdating = True

        'メッセージ表示
        MsgBox "処理前のシート「シート名一覧」は削除済みです"

        'シート追加
        Worksheets.Add before:=Worksheets(1)

        'シート名変更
        ActiveSheet.Name = "シート名一覧"

        'シート選択
        Worksheets("シート名一覧").Activate

        Worksheets("シート名一覧").Activate
        Worksheets("シート名一覧").Range("A1").Value = "シート名（現在）"
        Worksheets("シート名一覧").Range("B1").Value = "シート名（変更後）"

        For Each ws In Worksheets
            Cells(Selection.row + i, Selection.Column).NumberFormatLocal = "@"
            Cells(Selection.row + i, Selection.Column) = ws.Name
            i = i + 1
        Next

        ActiveSheet.Name = "シート名一覧"
        Columns("A:B").Select
        Columns("A:B").EntireColumn.AutoFit
        Selection.NumberFormatLocal = "@"

    Else

        'メッセージ表示
        MsgBox "キャンセルされました。処理を終了します。"

    End If

Else

    'シート追加
    Worksheets.Add before:=Worksheets(1)

    'シート名変更
    ActiveSheet.Name = "シート名一覧"

    'シート選択
    Worksheets("シート名一覧").Activate

    Worksheets("シート名一覧").Activate
    Worksheets("シート名一覧").Range("A1").Value = "シート名（現在）"
    Worksheets("シート名一覧").Range("B1").Value = "シート名（変更後）"

    For Each ws In Worksheets
        Cells(Selection.row + i, Selection.Column).NumberFormatLocal = "@"
        Cells(Selection.row + i, Selection.Column) = ws.Name
        i = i + 1
    Next

    ActiveSheet.Name = "シート名一覧"
    Columns("A:B").Select
    Columns("A:B").EntireColumn.AutoFit
    Selection.NumberFormatLocal = "@"

End If


End Sub

 

코드의 특징

파일 열기 대화상자를 표시한 후 취소를 클릭하면,
취소 처리되는 것에 대응하고 있습니다.

"책의 시트 이름을 일괄 대체하는 엑셀 VBA" 와 연동 가능하도록 하고 있습니다.