teratail header banner
teratail header banner
質問するログイン新規登録

回答編集履歴

1

コード追加

2021/05/06 05:40

投稿

hatena19
hatena19

スコア34367

answer CHANGED
@@ -10,4 +10,53 @@
10
10
  それよりもブックを一つずつ開いて閉じるという部分にはるかに時間がかかります。この部分を高速化できないかを検討するのが先決でしょう。「エクセルの神髄」さんのサイトに下記の情報があります。
11
11
  この方法でシート名を取得すると高速化できるでしょう。
12
12
 
13
- [Excelファイルを開かずにシート名を取得|VBAサンプル集](https://excel-ubara.com/excelvba5/EXCEL121.html)
13
+ [Excelファイルを開かずにシート名を取得|VBAサンプル集](https://excel-ubara.com/excelvba5/EXCEL121.html)
14
+
15
+ ---
16
+ 一応、[練習問題17(ブック・シートの操作の練習)解答|VBA練習問題解答](https://excel-ubara.com/excel-answer/EXCELVBA617A.html)の解答コードを配列を使用したものに書き直したコードです。(たいして高速化は期待できません。)
17
+
18
+ ```vba
19
+ Sub 練習問題17()
20
+ Dim i As Long
21
+ Dim j As Long
22
+ Dim wb As Workbook
23
+ Dim ws As Worksheet
24
+ Dim wsAns As Worksheet
25
+ Application.DisplayAlerts = False
26
+ For Each ws In Worksheets
27
+ If ws.Name = "練習17_回答" Then
28
+ ws.Delete
29
+ Exit For
30
+ End If
31
+ Next
32
+ Application.DisplayAlerts = True
33
+ Set wsAns = Worksheets.Add(after:=Worksheets("練習17"))
34
+ wsAns.Name = "練習17_回答"
35
+
36
+ Dim aryQ
37
+ aryQ = Worksheets("練習17").Range("A1").CurrentRegion.Value '練習データを配列に格納
38
+
39
+ Dim aryAns()
40
+ ReDim aryAns(1 To 2, 1 To 2) '回答格納用配列
41
+ aryAns(1, 1) = "ブック名"
42
+ aryAns(2, 1) = "シート名"
43
+
44
+ '↓ブック名、シート名を回答用配列に格納
45
+ j = 2
46
+ For i = 2 To UBound(aryQ)
47
+ Set wb = Workbooks.Open(aryQ(i, 1) & "\" & aryQ(i, 2))
48
+ aryAns(1, j) = wb.Name
49
+ For Each ws In wb.Sheets
50
+ aryAns(2, j) = ws.Name
51
+ j = j + 1
52
+ ReDim Preserve aryAns(1 To 2, 1 To j)
53
+ Next
54
+ wb.Close SaveChanges:=False
55
+ Next
56
+
57
+ '回答用配列を回答シートに出力
58
+ wsAns.Range("A1").Resize(j - 1, 2).Value = WorksheetFunction.Transpose(aryAns)
59
+
60
+ End Sub
61
+
62
+ ```