【Excel/VBA】テーブルデータをもとに複数のファイル作成③～クラス　シートモジュール　ディクショナリの実験的試行錯誤

前回、前々回、クラス、シートモジュールを使ってテーブルデータをもとにした複数ファイルの作成をやってみました。

【Excel/VBA】テーブルデータをもとに複数のファイル作成①～クラス　シートモジュール　ディクショナリの実験的試行錯誤

【Excel/VBA】テーブルデータをもとに複数のファイル作成②～クラス　シートモジュール　ディクショナリの実験的試行錯誤

今回は前回の地域ファイルに複数店舗のもちょっと変化版。コレクションをつかって、標準モジュールで動かしてみるバージョン。

コレクションは値を追加した順に１からインデックス番号が振られることを利用して順番にループを回す。

（１）テーブルデータ

「TB」シートにデータを入力しておく

no , tenpo , area
1 , 北海道店 , 北海道
2 , 福島店 , 東北
3 , 青森店 , 東北
4 , 東京店 , 関東
5 , 埼玉店 , 関東
6 , 福岡店 , 九州
7 , 長崎店 , 九州

（２）シートモジュール

TBシートのモジュールにクラスの構造体を利用してデータをコレクションにストックするコード、ストックしたデータをシートに書き込むコードを作成。

コレクションは標準モジュールでPubicの大域変数として宣言する。

TBシートのモジュールでPubicでコレクションを宣言すると、Sheet1.myClctといちいち書かなくてならず、めんどうなので標準モジュールで宣言。

テーブルシートから店舗no、店舗名、地域をコレクションに追加するコード

Sub getdataClct()
Dim i As Long
    Set myClct = New Collection
For i = 2 To Cells(Rows.Count, 1).End(xlUp).row
        Dim c As cdata
        Set c = New cdata
        c.no = Cells(i, 1).Value
        c.tenpo = Cells(i, 2).Value
        c.area = Cells(i, 3).Value
        myClct.Add c
        Set c = Nothing
    Next i

End Sub

標準モジュールからコレクションインデックスを引数として渡され、アクティブシートに店舗no、店舗名、地域を入力し、店舗名をシート名に変更するコード

Sub inputdataClct(ByVal idx_ As Long)
    With ActiveSheet
        .Range(“A2”).Value = myClct(idx_).no
        .Range(“B2”).Value = myClct(idx_).tenpo
        .Range(“C2”).Value = myClct(idx_).area
        .Name = myClct(idx_).tenpo
    End With
End Sub

（3）標準モジュール

Public myClct As Collection　　　　　　　’PublicでコレクションmyClctを宣言

Sub 複数シートのファイル複製()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim path As String 　　　　　　 ‘ファイルを保存するフォルダ
    path = ThisWorkbook.path & “\”

    Dim wsGen As Worksheet    　　　’原本シートセット
    Set wsGen = Worksheets(“原本”)

    Sheet1.getdataClct　　　‘※１：シートモジュールのプロシージャを呼出

    ‘コレクションの最初から最後まで
    Dim cnt As Long, idx As Long, wsGen2 As Worksheet, vArea As String
    Dim key As String

    cnt = myClct.Count　　　　 ‘コレクションの要素数
    idx = 1　　　　　　　　　　’idxに1を代入

    Do
wsGen.Copy
        Set wsGen2 = ActiveSheet
        Do
            wsGen2.Copy Before:=wsGen2
Sheet1.inputdataClct(idx)　　’※２：シートモジュールのプロシージャを呼出
            vArea = myClct(idx).area

            idx = idx + 1　　　　　’idxに1をプラス
            If idx > cnt Then　　　’idxがコレクション要素数より大ならループ抜ける
                Exit Do
            End If

        Loop Until myClct(idx).area <> vArea　　　　　’地域の切替でLoopぬける

        wsGen2.Delete　　　　　’コピー元シート削除
        With ActiveWorkbook　　　　　’ファイル名前を付けて保存して閉じる
            .SaveAs Filename:=path & vArea & “.xlsx”
            .Close
        End With

    Loop Until idx > cnt　　　’idxがコレクション要素数より大なら繰り返し処理終了

    Set myClct = Nothing
Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox “処理終了”
End Sub

idxを1から1ずつプラス、コレクション要素数分繰り返し処理。

地域の切り替わりでファイル保存。

※1、※２はTBシート（Sheet1)のプロシージャを呼び出ししている。

シートのSubプロシージャ呼び出しは

Sheet1.プロシージャ名（引数）

または

Sheet1.プロシージャ名引数

または

Call Sheet1.プロシージャ名（引数）

とする。（引数がない場合はSheet1.プロシージャ名）

このシリーズは以上です。

①TBのデータをもとにファイルを複数作成するマクロ。