練習問題18（Dir関数の練習）回答

最終更新日：2015-10-22

練習問題18（Dir関数の練習）回答

練習問題18の回答ページです、

問題

・A1に指定したフォルダ内にある、
　全てのエクセルファイル（xls,xlsx,xlsm）のブック名をA2以降に、
　そのブックの全シート名をB2から右にに入れて下さい。（B2,C2,D2,・・・と全シート名を横に入れる）

※サブフォルダ以下のファイルは無視して下さい。

　　Ａ　　　　　Ｂ　　　　　Ｃ　　　　Ｄ

C:\User
ブック名	シート名1	シート名2	・・・

※上記表の全体選択し、コピー(Ctrl+C)の後、エクセルのシートのA1セルに貼り付け(Ctrl+V)してください。

では、お考えください。

すぐに回答を見ずに、必ず自力で書けるとこまででも良いので書きましょう。

・
・・
・・・
・・・・
・・・・・

当サイトのコンテンツ

ExcelマクロVBA入門

ここで、じっくり勉強して下さい。

・
・・
・・・
・・・・
・・・・・

では、回答です。

Sub 練習問題18()
　　Dim i As Long
　　Dim j As Long
　　Dim strFileName As String
　　Dim wb As Workbook
　　Dim ws As Worksheet
　　Dim wsOwn As Worksheet
　　Set wsOwn = ActiveSheet
　　i = 2
　　strFileName = Dir(Cells(1, 1) & "\*.xls*")
　　Do While strFileName <> ""
　　　　Set wb = Workbooks.Open(wsOwn.Cells(1, 1) & "\" & strFileName)
　　　　j = 2
　　　　wsOwn.Cells(i, 1) = wb.Name
　　　　For Each ws In wb.Sheets
　　　　　　wsOwn.Cells(i, j) = ws.Name
　　　　　　j = j + 1
　　　　Next
　　　　wb.Close SaveChanges:=False
　　　　i = i + 1
　　　　strFileName = Dir()
　　Loop
End Sub

これはもう、基本中の基本の組み合わせです。
なんの迷いもなく、一気にかけるようなるまで練習して下さい。

以下も参考にして下さい。

ExcelマクロVBA入門.第79回.ファイル操作Ⅰ（Dir）