2020/12/28
こんにちは、キャンベルです。
最近は週2-3回のペースでお昼にラーメンを食べています。
さて今回は、指定したフォルダ配下にあるExcelブックのシート名を一気に取得する方法について、ご紹介します。
ご紹介するサンプルでは、再帰的には取得しておりません。
再帰的に取得したい場合は、こちらの記事と合わせてお読みください。
:::[VBA]サブフォルダ含むファイル一覧を再帰的に取得する:::
まずは準備から。一覧を表示するためのシートを用意します
イメージとしては、このような順番で結果が表示されるように作っていきます。
- A2セルにフォルダパスを記入
- ボタンクリック
- 指定したパスの直下のExcelファイルのシート名をずらっと表示
では早速、以下のようなシートを一つ作っておきます。
A2セルをパス入力欄、その横に「シート一覧取得」ボタンを設置、5行目から下を結果表示エリアとします。
ボタンの設定の方法などは今回は触れません。
また、ボタンは最後にマクロを割り当てるので、今は設置のみでOKです。
では早速記述していきましょう!
1. Visual Basicエディタの起動
まずはVBAのエディタを起動します。
ショートカットだと、Alt+F11キーで起動します。
メニューからだと、[開発]→[Visual Basic]で同じ動作になります。
[開発]メニューが表示されていない方は、まず表示させることから始めてください。
(ここでは触れませんので、分からない方は調べてくださいね)
※メニュー[ツール]→[参照設定]で、「Microsoft Scripting Runtime」にチェックが入っていない場合はチェックしておきましょう。
2. モジュール作成
エディタが起動したら、メニューより[挿入]→[標準モジュール]をクリックします。
すると、左側のプロジェクトエクスプローラに「Module1」というファイルが追加されるので、クリックします。
3. コード記述
白い画面に以下をコピペしてください。
なるべく業務でそのまま使えるよう丁寧に書いたので、少し長めになっています。
必要ない部分はカットしてください。
Option Explicit
Sub getSheetName()
Dim fileArr() As String: ReDim fileArr(0)
Dim sheetArr(1000, 1)
Dim buf As String
Dim path As String
Dim i As Long, num As Long
Dim tmpWb As Object, tmpSh As Object
Dim rowNum As Long, maxRow As Long
Dim errChk, Ans, preFileNm
'結果表示行
rowNum = 5
'データクリア
maxRow = Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(rowNum, 1), Cells(1000, 2)).ClearContents
'パスの最後に「¥」が付いていたら削除
path = Trim(Cells(2, 1))
If Right(path, 1) = "¥" Then
path = Left(path, Len(path) - 1)
End If
'ディレクトリ存在チェック
errChk = Dir(path, vbDirectory)
If errChk = "" Then
Ans = MsgBox("パスが見つかりません", vbYesNo, "info")
If Ans = vbNo Then Exit Sub
End If
'ディレクトリ内のファイル名を配列に格納
buf = Dir(path & "¥*.*")
i = 0
Do While buf <> ""
ReDim Preserve fileArr(i)
fileArr(i) = buf
buf = Dir()
i = i + 1
Loop
'拡張子「.xls」が含まれるファイルのシート名を取得
Application.ScreenUpdating = False
num = 0
For i = 0 To UBound(fileArr)
If InStr(fileArr(i), ".xls") > 0 Then
'自身がいたら処理をスキップ
If InStr(fileArr(i), ThisWorkbook.Name) = 0 Then
Set tmpWb = Workbooks.Open(Filename:=path & "¥" & fileArr(i), ReadOnly:=True)
ActiveWindow.Visible = False
For Each tmpSh In tmpWb.Sheets
sheetArr(num, 0) = fileArr(i) 'ファイル名
sheetArr(num, 1) = tmpSh.Name 'シート名
num = num + 1
Next
tmpWb.Close (False)
End If
End If
Next i
Application.ScreenUpdating = True
'シート名一覧の作成
i = 0
Do While sheetArr(i, 0) <> ""
'ファイル名は最初のシートのみ出力
If preFileNm <> sheetArr(i, 0) Then
Cells(i + rowNum, 1) = sheetArr(i, 0)
End If
Cells(i + rowNum, 2) = sheetArr(i, 1)
preFileNm = sheetArr(i, 0)
i = i + 1
Loop
End Sub
ボタンにマクロを割り当てれば完了!
最初に設置した「シート一覧取得」ボタンに作ったマクロを割り当てます。
ボタンを右クリック→[マクロの登録]と押すと、先ほど登録したマクロ名「getSheetName」が出てきますので、選択してください。
A2セルにフォルダパスを入力して、ボタンをクリックしてみてください。
うまく表示されましたか?
まとめ
いかがでしたか?
業務効率化などでお使いいただければ幸いです。
自身のシート名を取得するだけならこれだけなので簡単なのですが、フォルダ内だと色々と手間がかかりますね。
Sub wk()
Dim tmpSh As Object
For Each tmpSh In Sheets
Debug.Print tmpSh.Name
Next
End Sub
ではまたお会いしましょう。