以下の内容はhttps://www.limecode.jp/entry/fungo/059-split-monthly-sheets-into-quartersより取得しました。


59本目:12ヶ月分のシートを四半期で分割

Excel&VBA解説サイト「エクセルの神髄」様出題の問題集、
VBA100本ノック」に対する私の回答と解説のページです。

100本ノックの出題リストはこちらから
excel-ubara.com

出題:12ヶ月分のシートを四半期で分割

#VBA100本ノック 59本目
ブック(ThisWorkbook)には「2020年04月」から「2021年03月」の12シートがあります。
四半期ごとのシートで1ブックとして、同一フォルダに出力ください。
「2020年04月」「2020年05月」「2020年06月」この3シートで→1Q.xlsx
以下同様に4Q.xlsxまでの4ファイル

対象シート
分割ファイル

◇ 出題ページはこちら

ソースコード

Option Explicit

' 100本ノック059:12ヶ月分のシートを四半期で分割
Sub 四半期別ファイルを出力する()

    ' 年・Qをループ
    Dim 対象年 As Long
    For 対象年 = 2000 To 2100
        Dim 対象Q As Long
        For 対象Q = 1 To 4
        
            ' 対象3シートの名称を配列にセット
            Dim Arrシート名リスト
            Select Case 対象Q
                Case 1 To 3
                    Dim 対象月 As Long: 対象月 = 対象Q * 3 + 1
                    Arrシート名リスト = Array(対象年 & "年" & Format(対象月, "00") & "月" _
                                                      , 対象年 & "年" & Format(対象月 + 1, "00") & "月" _
                                                      , 対象年 & "年" & Format(対象月 + 2, "00") & "月")
                Case 4
                    Arrシート名リスト = Array(対象年 + 1 & "年01月" _
                                                      , 対象年 + 1 & "年02月" _
                                                      , 対象年 + 1 & "年03月")
            End Select
        
            ' 3シートそろっているQへ出力処理
            On Error Resume Next
            Dim 四半期シート群 As Sheets: Set 四半期シート群 = Nothing
            Set 四半期シート群 = ThisWorkbook.Worksheets(Arrシート名リスト)
            On Error GoTo 0
            
            If Not 四半期シート群 Is Nothing Then

                四半期シート群.Copy
                Dim wb出力ブック As Workbook: Set wb出力ブック = ActiveWorkbook
                
                Dim Path出力フォルダ As String
                Path出力フォルダ = ThisWorkbook.Path & "\" & 対象年 & "年"
                MkDir Path出力フォルダ
                
                wb出力ブック.SaveAs Path出力フォルダ & "\" & 対象Q & "Q.xlsx"
                wb出力ブック.Close False
                
            End If
            
        Next
    Next

End Sub

解説

ブック内のシートを3つずつ別のブックに出力する問題です。

どこまでを自動対応するか自由度の高い問題ですが、
今回は「全年・四半期で3シートそろっているものを出力」という仕様にしました。


複数シートを一括で行う場合は、シート名の配列を作って

Worksheets(Array("Sheet1", "Sheet2", "Sheet3"))

この形に持っていければよいです。


シート名の配列を作る部分は年と年度の違いに気を付ける必要があり、
1~3月は対象の年度とシート名にズレが生じます。

この判定を綺麗に計算式にしようとしても難読化するだけですし、
所詮4種類の分岐ですので、解答のように1~3月だけベタ打ちして問題ありません。


年度対応はSelect Caseで愚直に書いた方が読みやすいことも多いので、
Modを複雑に使った無駄にエレガントな数式を組まないように気を付けましょう。




以上の内容はhttps://www.limecode.jp/entry/fungo/059-split-monthly-sheets-into-quartersより取得しました。
このページはhttp://font.textar.tv/のウェブフォントを使用してます

不具合報告/要望等はこちらへお願いします。
モバイルやる夫Viewer Ver0.14