総合練習問題7回答｜ExcelマクロVBA練習問題解答

最終更新日：2018-07-15

第67回.総合練習問題7回答

回答ページです、ブックとシートを扱う問題です。

では問題です、まず以下を見て下さい。

Excel解説

シート「ブック一覧」のA列にパス、B列にブック名が入っています。

このブックを開き、中の全てのシート名を取得して下さい。

先頭に「シート一覧」というシート追加し、

A列にブック名、B列にシート名を書き出して下さい。

ただし、繰り返し実行可能なように、

既に「シート一覧」というシートがある場合も考慮する事。

結果は以下のようになります。

Excel解説

少し難しいプログラムになります。

では、

・

・・

・・・

・・・・

・・・・・

はい、

では回答です。

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ステートメントをうまく使うと、マクロがすっきりします。

何度も書いて覚えて下さい。