ExcelマクロVBA練習問題解答
第67回.総合練習問題7解答

ブックとシートを扱う問題です。
まず以下を見て下さい。

シート「ブック一覧」のA列にパス、B列にブック名が入っています。
このブックを開き、中の全てのシート名を取得して下さい。
先頭に「シート一覧」というシート追加し、
A列にブック名、B列にシート名を書き出して下さい。
ただし、繰り返し実行可能なように、既に「シート一覧」というシートがある場合も考慮する事。
結果は以下のようになります。

少し難しいプログラムになります。
ヒント！

シンキングタイム開始
シンキングタイム終了

では解答のマクロVBAコードです。

Sub 練習1() 　　Dim i As Long 　　Dim OutRow As Long 　　Dim wb読込 As Workbook 　　Dim ws一覧 As Worksheet 　　Dim ws As Worksheet 　　 　　Application.ScreenUpdating = False 　　Application.DisplayAlerts = False 　　 　　'シート「シート一覧」を削除 　　On Error Resume Next 　　Worksheets("シート一覧").Delete 　　On Error GoTo 0 　　 　　'「シート一覧」を作成 　　Set ws一覧 = Sheets.Add(Before:=Sheets(1)) 　　ws一覧.Name = "シート一覧" 　　ws一覧.Range("A1").Value = "ブック名" 　　ws一覧.Range("B1").Value = "シート名" 　　 　　'「シート一覧」２行目から 　　OutRow = 2 　　With Worksheets("ブック一覧") 　　　　For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row 　　　　　　'ブックを開く 　　　　　　Set wb読込 = Workbooks.Open(.Cells(i, 1) & "\" & .Cells(i, 2)) 　　　　　　'ブック名を出力 　　　　　　ws一覧.Cells(OutRow, 1) = wb読込.Name 　　　　　　'全シート名を出力 　　　　　　For Each ws In wb読込.Sheets 　　　　　　　　ws一覧.Cells(OutRow, 2) = ws.Name 　　　　　　　　OutRow = OutRow + 1 　　　　　　Next ws 　　　　　　'開いたブックを閉じる 　　　　　　wb読込.Close SaveChanges:=False 　　　　Next i 　　End With 　　 　　Application.DisplayAlerts = True 　　Application.ScreenUpdating = True End Sub

それなりに長いマクロになっています。
今までに説明した、ステートメント・プロパティ・メソッドだけを使ったつもりです。
書き方は色々あります。

'シート「シート一覧」を削除 On Error Resume Next Worksheets("シート一覧").Delete On Error GoTo 0

この部分は、

For Each ws In Sheets 　　If ws.Name = "シート一覧" Then 　　　　ws.Delete 　　End If Next ws

本来は、このように書く方が良いでしょう。
On Error のサンプルをかねて、回答ではこのようにしてみました。
Setステートメントをうまく使うと、マクロがすっきりします。
何度も書いて覚えて下さい。

同じテーマの記事
新着記事
アクセスランク