練習問題17(エクセルの神髄)を配列で実行したい

Question

エクセルの神髄の練習問題17について、回答通りの動作をを配列にて実行する方法を模索しております。
連想配列やユーザー定義型の使用も考えましたが、ブック名とブック名に対応するシート名を切り分けて配列に格納し、回答シートに吐き出せばいいかいまいちピンときません。
どなたかベストな記述を教えて頂けたら幸いです。よろしくお願いします。
練習問題17リンク

Answer 1

一旦配列に格納して、それをシートに出力するようにしたい。
という質問だとして回答します。
尚、今回の回答として関係ない所は省いています。

Private Type Book_Type
    BookName As String
    SheetNames() As String
End Type

Public Sub test()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wsAns As Worksheet
    
    Set wsAns = Worksheets("練習17_回答")
    
    Dim tBooks() As Book_Type
    
    With Worksheets("練習17")
        ReDim tBooks(.Cells(.Rows.Count, 1).End(xlUp).Row - 2)
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            Set wb = Workbooks.Open(.Cells(i, 1) & "\" & .Cells(i, 2), False, True)
            tBooks(i - 2).BookName = wb.Name
            ReDim tBooks(i - 2).SheetNames(wb.Sheets.Count - 1)
            j = 0
            For Each ws In wb.Sheets
                tBooks(i - 2).SheetNames(j) = ws.Name
                j = j + 1
            Next
            wb.Close SaveChanges:=False
        Next
    End With

    k = 2
    For i = 0 To UBound(tBooks)
        wsAns.Cells(k, 1).Value = tBooks(i).BookName
        For j = 0 To UBound(tBooks(i).SheetNames)
            wsAns.Cells(k, 2).Value = tBooks(i).SheetNames(j)
            k = k + 1
        Next
    Next

End Sub

シンプルなのだとこんなのでいいんじゃないでしょうか。

Comments

[kazuki51]

ご回答ありがとうございます。
xail2222さんの回答は私が当初目指していた記述に近いものであり、ユーザー定義型内でさらに配列を宣言できるという発想が私には抜けておりましたので大変参考になりました。

[xail2222]

今回の目的はtatuya51さんが、配列の使い方をマスターする事でしょうから
いくつかのパターンを試してみるのが良いかと思います。

良いプログラムと配列の使い方の習得に役立つプログラムの評価基準は別物と思います。
その為「ベストな記述」と言うのは私には違和感がありました。

[kazuki51]

xail2222さんのおっしゃる通り「ベストな記述」という表現はよくなかったですね。
今後気を付けたいと思います。

Answer 2

書いてみた。

Sub sample()
    With Worksheets("練習17")
        
        Dim arrBooks(), arrSheets()
        Dim wPath, wBook
        Dim i, j
        Dim ws As Worksheet
        
        For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
            wPath = .Cells(i, 1).Value
            wBook = .Cells(i, 2).Value
            
            With Workbooks.Open(wPath & "\" & wBook)
                For Each ws In .Worksheets
                    j = j + 1
                    ReDim Preserve arrBooks(j)
                    ReDim Preserve arrSheets(j)
                    If ws.Index = 1 Then arrBooks(j) = wBook
                    arrSheets(j) = ws.Name
                Next
                .Close False
            End With
        Next
    End With
    
    arrBooks(0) = "ブック名"
    arrSheets(0) = "シート名"
    
    For Each ws In Worksheets
        If ws.Name = "練習17_回答" Then Exit For
    Next
    If Not ws Is Nothing Then ws.Delete
    Worksheets.Add.Name = "練習17_回答"
    Worksheets("練習17_回答").Cells.Resize(j + 1, 2).Value = WorksheetFunction.Transpose(Array(arrBooks, arrSheets))

End Sub

Comments

[kazuki51]

ご回答ありがとうございます。
1点質問ですが、最後の「WorksheetFunction.Transpose(Array(arrBooks, arrSheets))」について、それぞれ一次元配列であるarrBooksとarrSheetsをArray関数で二次元配列に変換しているという認識でよろしいでしょうか？（このようなArrayの使い方を初めて見たもので、、）

[jinoji]

Arrayについてはご認識の通りです。
私も最初はこんな使い方は知らず、いろいろ試しているうちに見つけました。
出力を見越して最初から二次元配列で処理してもよいのですが、お題に沿ってブック名の配列、シート名の配列をそれぞれ用意した都合上、このようにしてみました。

まあ今回の場合、ループを回して一つずつ出力しても大して大変でもないと思いますが。

[kazuki51]

Arrayはこのような使い方もできるのですね。
今後配列を扱うときの参考にさせていただきます。
ご回答ありがとうございました。

Answer 3

「回答通りの動作をを配列にて実行する」目的は何でしょうか。

ブック数が多くて時間かかかるのでそれを高速化したい。
WEBで配列を使うと高速化できるという情報があるので、配列にしたら高速化できるだろ。

ということでしょうか。
配列で高速化できるは、セルの読み書きです。広範囲のセルの参照や書き込みを配列を使うと一度に読み書きできるので高速化できます。
今回の要件だと参照したいブックの数は多くても数百ですよね。それぐらいなら配列を使っても、直接セルに読み書きしてもそれほど差はでないと思います。

それよりもブックを一つずつ開いて閉じるという部分にはるかに時間がかかります。この部分を高速化できないかを検討するのが先決でしょう。「エクセルの神髄」さんのサイトに下記の情報があります。
この方法でシート名を取得すると高速化できるでしょう。

Excelファイルを開かずにシート名を取得｜VBAサンプル集

---

一応、練習問題17（ブック・シートの操作の練習）解答｜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
    Set wsAns = Worksheets.Add(after:=Worksheets("練習17"))
    wsAns.Name = "練習17_回答"
    
    Dim aryQ
    aryQ = Worksheets("練習17").Range("A1").CurrentRegion.Value    '練習データを配列に格納

    Dim aryAns()
    ReDim aryAns(1 To 2, 1 To 2)    '回答格納用配列
    aryAns(1, 1) = "ブック名"
    aryAns(2, 1) = "シート名"

    '↓ブック名、シート名を回答用配列に格納
    j = 2
    For i = 2 To UBound(aryQ)
        Set wb = Workbooks.Open(aryQ(i, 1) & "\" & aryQ(i, 2))
        aryAns(1, j) = wb.Name
        For Each ws In wb.Sheets
            aryAns(2, j) = ws.Name
            j = j + 1
            ReDim Preserve aryAns(1 To 2, 1 To j)
        Next
        wb.Close SaveChanges:=False
    Next

    '回答用配列を回答シートに出力
    wsAns.Range("A1").Resize(j - 1, 2).Value = WorksheetFunction.Transpose(aryAns)

End Sub

Comments

[kazuki51]

ご回答ありがとうございます。
目的としては配列の扱いに慣れるという意味で練習問題を片っ端から配列を使用したやり方で実行しており、練習問題17でつまずいたので質問させていただきました。(他に良い練習法があれば教えて頂けると幸いです、、)
またhatena19さんのご指摘通り、初心者ながら私も実務で多数のブックを扱うことがありますが、ブックを開いて閉じる作業を高速化するという観点は抜けており、大変参考になりました。
コードにつきましても2次元配列の扱い方について理解が浅かったためとても勉強になる内容でした。
ありがとうございました。

[hatena19]

目的もなしになんでも配列にすればいいというものではありません。
配列にすることで高速化できるというのが最大のメリットです。それなし配列にしても無意味ですし、コードが複雑になり読みにくくなるというデメリットだけになります。

配列で高速化するには、Range.Value で一気に配列に読み込み、配列をRange.Value に一気に書き込む、という方法にします。
これにより、セルへのアクセスが2回ですみます。セルへのアクセスは重い処理なのでそれをなるべく少ないくするという考え方です。

ループでセルを一つずつ参照して、配列に格納する、
配列をループして、セル一つずつに代入していく、
という方法も確かに配列を使っていますが、高速化というメリットはないです。ただ単に複雑になるというデメリットだけになります。

[kazuki51]

確かに実務においても何でもかんでも配列を使ってみようとしていたので改めようと思います。
ご回答ありがとうございました。