VBA Excelのシート一覧を取得するマクロ

vba

Excelファイルのシート名一覧を取得するマクロです。フォルダ内にある全てのExcelファイルの全シート名をCSVファイルで出力します。

Excelのシート名取得マクロ

◾️Excelシート名取得マクロ

Sub excel_sheets()
    '画面更新オフ
    Application.ScreenUpdating = False
    
    '####################################
    '###変数定義
    '####################################
    '現在のフォルダ
    Dim mydir As String
    '対象のエクセルファイル
    Dim file As String
    '各シート
    Dim ws As Variant
    'CSVファイル
    Dim csvfile As String
    'CSVオープン用ファイルナンバー
    Dim filenumber As String
    'ウィンドウ設定
    Dim msg1 As String
    'マクロファイル名
    Dim myfile As String
    '現在の日時
    Dim n As Date
    '区切り文字パターン
    Dim array_delimiter As Variant
    '区切り文字選択
    Dim delimiter As String

    '####################################
    '###事前準備
    '####################################
    '現在のファイルを取得
    mydir = ThisWorkbook.Path & "/"
    'ファルダ内のエクセルを取得
    file = Dir(mydir & "*.xls")
    'ファイルナンバーを割り当て
    filenumber = FreeFile
    '実行マクロファイル名
    myfile = ThisWorkbook.Name
    '現在の日時取得
    n = now
    'CSVファイル出力設定
    csvfile = mydir & Format(n, "yyyymmdd_hhmmss") & "_output.csv"
    '区切り文字パターン
    array_delimiter = Array("[1]カンマ区切り", "[2]タブ区切り", "[3]指定文字区切り")
    
    '####################################
    '###選択
    '####################################
    '区切り文字選択
    delimiter = InputBox("出力するCSVファイルの区切り文字を" & vbCrLf & "以下の選択肢の数字を選んでください" & vbCrLf & "(デフォルト=カンマ区切り)" & vbCrLf & vbCrLf & Join(array_delimiter, vbCrLf), "選択", Default:=1)
    '入力チェック
    If StrPtr(delimiter) = 0 Then
        MsgBox "マクロを終了します。"
        Exit Sub
    End If
    
    
    '選択エラー判定
    Select Case delimiter
        '区切り文字の指定
        Case "1", "2"
            '何もしない
        '区切り文字の指定
        Case "3"
            '区切り文字指定
            re_delimiter = InputBox("出力するCSVファイルの区切り文字を" & vbCrLf & "以下の選択肢の数字を選んでください" & vbCrLf & "[3]指定文字区切り" & vbCrLf & " └>区切る文字を入力してください。", "選択", Default:="★★★")
            '入力チェック
            If StrPtr(re_delimiter) = 0 Then
                MsgBox "区切り文字が無効です。マクロを終了します。"
                Exit Sub
            End If
        '入力間違いの場合終了
        Case Else
            MsgBox "選択が無効です。マクロを終了します。"
            Exit Sub
            
    End Select

    '####################################
    '###取得設定
    '####################################
    'CSVファイルオープン
    Open csvfile For Output As #filenumber
    
    'エクセルごとの処理
    Do While file <> ""
    
        'xlsx/xlsをオープン ※xlsmファイルは除く
        If LCase(file) Like "*.xls?" And Not (LCase(file) Like "*.xlsm") Then
        
            'エクセルオープン
            Workbooks.Open Filename:=mydir & file
            
            'CSVに出力
            For Each ws In Sheets
                '区切り文字ごとの処理
                Select Case delimiter
                    Case "1"
                        'カンマ区切り
                        Print #filenumber, file & "," & ws.Index & "," & ws.Name
                    Case "2"
                        'タブ区切り
                        Print #filenumber, file & vbTab & ws.Index & vbTab & ws.Name
                    Case "3"
                        '特定文字区切り
                        Print #filenumber, file & re_delimiter & ws.Index & re_delimiter & ws.Name
                End Select
            Next
            'エクセルクローズ
            Workbooks(file).Close SaveChanges:=False
        End If
        
        'ループ次の処理
        file = Dir

    Loop
    
    'CSVファイルを閉じる
    Close #filenumber
    
    '終了処理
    msg1 = "全シート名を取得しました。" & vbCrLf & "以下のファイルを確認してください。" & vbCrLf & csvfile
    MsgBox msg1

   '画面更新オン
    Application.ScreenUpdating = True

End Sub

Excelマクロの作成方法は以下を参考にしてください。

Excelのシート名取得マクロの使い方

■使用方法
上記マクロをExcelマクロ(.xlsb)に記載して保存します。任意のフォルダにExcelマクロとシート名を取得したいExcelファイルを配置し、マクロを実行すると自動で取得しCSVファイルで出力します。

①エクセルマクロとシート名を取得したいエクセルを同じフォルダに配置(※複数可能)

②マクロを実行すると以下ウィンドウが表示されますので、CSVの区切り文字を入力後OKを押します。

③しばらくすると以下ウィンドウが表示されますので、OKを押すとマクロが終了します。

④同じフォルダの階層にcsvファイルが出力されます。

⑤CSVファイルを確認します。ファイル名、連番、シート名が記載されます。

以上です。訪問者様の何かの助けになれば幸いです。

コメント