練習問題17（ブック・シートの操作の練習）回答

最終更新日：2015-10-22

練習問題17（ブック・シートの操作の練習）回答

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

問題

※まず最初に
　A列にパス、B列にブック名（エクセルのファイル名）を、
　実際のあなたのPC環境に合わせて入力して下さい。

・シート「練習17_回答」を新規に追加し、
　そのA列にブック名
　B列にそのブックの全シート名の一覧を入れて下さい。

・繰り返し実行できるように、
　シート「練習17_回答」が既に存在した場合は、
　一旦削除してから、シート追加して下さい。

　Ａ　　　　　Ｂ

パス	ブック名
C:\User	Book1.xls
C:\User	サンプル.xls
C:\User	test.xls

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

以下が完成イメージです。
Excelサンプル画像

では、お考えください。

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

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

当サイトのコンテンツ

ExcelマクロVBA入門
マクロの記録で覚えるVBA

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

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

では、回答です。

Sub 練習問題17()
　　Dim i As Long
　　Dim j As Long
　　Dim wb As Workbook
　　Dim ws As Worksheet
　　Dim wsAns As Worksheet
　　Application.DisplayAlerts = False
　　For Each ws In Worksheets
　　　　If ws.Name = "練習17_回答" Then
　　　　　　ws.Delete
　　　　　　Exit For
　　　　End If
　　Next
　　Application.DisplayAlerts = True
　　Worksheets.Add after:=Worksheets("練習17")
　　Set wsAns = ActiveSheet
　　With wsAns
　　　　.Name = "練習17_回答"
　　　　.Cells(1, 1) = "ブック名"
　　　　.Cells(1, 2) = "シート名"
　　End With
　　j = 2
　　With Worksheets("練習17")
　　　　For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
　　　　　　Set wb = Workbooks.Open(.Cells(i, 1) & "\" & .Cells(i, 2))
　　　　　　wsAns.Cells(j, 1) = wb.Name
　　　　　　For Each ws In wb.Sheets
　　　　　　　　wsAns.Cells(j, 2) = ws.Name
　　　　　　　　j = j + 1
　　　　　　Next
　　　　　　wb.Close SaveChanges:=False
　　　　Next
　　End With
End Sub

Application.DisplayAlerts = True
のタイミングは、どこでも良いですし、書かなくても問題ありません。
でも、なるべく適切な位置に書くようにしましょう。

For～Each
ではなく、
For カウンター = 1 To Worksheets
・・・
Next
での処理も書けるようにしておきましょう。
シート削除なら