VBA100本ノック 38本目：1シートを複数シートに振り分け

この記事から得るもの

日付データから、祝日、平日、休日の判断ができるようになる。
書込み処理のサブルーチン化のやり方が分かる。

目次
　１　今回のお題
　２　今回のお題の意図
　３　回答
　４　感想　
　５　英語の勉強　

１　今回のお題

「売上」シートのA列に日付が昇順で入っています。
土日祝と平日に分けて別シートに出力してください。
・「売上」シートの列数は不定。
・「土日祝」「平日」シートは既存です。
・祝日は「祝日」シートのA列にあります。
※セルの書式の扱いは任意

f:id:bimori466:20201219043111p:plain

f:id:bimori466:20201219043145p:plain

excel-ubara.com

２　今回のお題の意図

Weekday関数を使って曜日を取得し、条件分岐する。
Countif関数を使って祝日の、条件分岐をする。

３　回答

私の最初の回答

Sub ノック38本目_1()

Dim wirteWeekdays_IX As Long: wirteWeekdays_IX = 1  '平日書込み用
Dim writeHolidays_IX As Long: writeHolidays_IX = 1  '休日書込み用

Dim wsEarnings As Worksheet: Set wsEarnings = Worksheets("売上")
Dim wswriteHolidays As Worksheet: Set wswriteHolidays = Worksheets("土日祝")
Dim wswriteWeekdays As Worksheet: Set wswriteWeekdays = Worksheets("平日")
Dim wsPublicHoliday As Worksheet: Set wsPublicHoliday = Worksheets("祝日")

Dim endFlg As Boolean


For i = 2 To wsEarnings.Range("A1").CurrentRegion.Rows.Count
    mydate = wsEarnings.Cells(i, 1): endFlg = False
    
    '祝日の処理
    For j = 1 To wsPublicHoliday.Range("A1").CurrentRegion.Rows.Count
        If mydate = wsPublicHoliday.Cells(j, 1) Then
            
            '祝日書込み処理
            If writeHolidays_IX = 1 Then
                For k = 1 To wsEarnings.Range("A1").CurrentRegion.Columns.Count
                    wswriteHolidays.Cells(writeHolidays_IX, k) = wsEarnings.Cells(1, k)
                Next
            End If
            
            writeHolidays_IX = writeHolidays_IX + 1 '書込み変数インクリメント
            
            For k = 1 To wsEarnings.Range("A1").CurrentRegion.Columns.Count
                wswriteHolidays.Cells(writeHolidays_IX, k) = wsEarnings.Cells(i, k)
            Next
            
            endFlg = True
            
        End If
    Next
    
    
    '平日、土日の処理
    If endFlg = False Then
        If Weekday(mydate) = 7 Or Weekday(mydate) = 1 Then
            '休日書込み処理
            If writeHolidays_IX = 1 Then
                For k = 1 To wsEarnings.Range("A1").CurrentRegion.Columns.Count
                    wswriteHolidays.Cells(writeHolidays_IX, k) = wsEarnings.Cells(1, k)
                Next
            End If
            
            writeHolidays_IX = writeHolidays_IX + 1 '書込み変数インクリメント
            
            For k = 1 To wsEarnings.Range("A1").CurrentRegion.Columns.Count
                wswriteHolidays.Cells(writeHolidays_IX, k) = wsEarnings.Cells(i, k)
            Next
            
        Else
            '平日書込み処理
            If wirteWeekdays_IX = 1 Then
                For k = 1 To wsEarnings.Range("A1").CurrentRegion.Columns.Count
                    wswriteWeekdays.Cells(wirteWeekdays_IX, k) = wsEarnings.Cells(1, k)
                Next
            End If
            
            wirteWeekdays_IX = wirteWeekdays_IX + 1 '書込み変数インクリメント
            
            For k = 1 To wsEarnings.Range("A1").CurrentRegion.Columns.Count
                wswriteWeekdays.Cells(wirteWeekdays_IX, k) = wsEarnings.Cells(i, k)
            Next
            
        End If
    End If
    
Next

End Sub

まずは、平日Sheet、土日祝日Sheet書込み用変数を１として宣言します。
また、各Sheetをオブジェクト変数にSetします。

メイン処理は、まず祝日がどうかを変数mydateに売上Sheetの日付を代入し、祝日Sheetのデータをループ処理して探す。
次に、祝日で無い場合は、Weekday関数を使って土日か判断をする。土日であれば、土日祝日Sheet書込みし、それ以外（平日）なら平日Sheetに書込みます。

これをTwitterに投稿したところ、サイト管理者から以下のツッコミがありました。

「祝日の判定をループせずに出来るとより良いと思います。」

ループ処理せずに判定できる方法あるの？？と思いました。しかし、サイトの回答を見てみるとCountifを使っていることに気づきました。
そうか、処理対象の日付が祝日Sheetないにあれば、Countifが戻り値が０以上になる！そこで判断すればいいのかということに気づきました。

また、書込み処理部分が長くなってしまうので、書込み処理はサブルーチン化しました。

私の最終回答

'モジュールレベルの変数宣言
Dim wirteWeekdays_IX As Long: Dim writeHolidays_IX As Long

Dim wsEarnings As Worksheet: Dim wswriteHolidays As Worksheet
Dim wswriteWeekdays As Worksheet: Dim wsPublicHoliday As Worksheet

Dim i As Long: Dim endFlg As Boolean: Dim mydate As Date

Sub ノック38本目_2()

wirteWeekdays_IX = 1  '平日書込み用
writeHolidays_IX = 1  '休日書込み用

Set wsEarnings = Worksheets("売上"): Set wswriteHolidays = Worksheets("土日祝")
Set wswriteWeekdays = Worksheets("平日"): Set wsPublicHoliday = Worksheets("祝日")

For i = 2 To wsEarnings.Range("A1").CurrentRegion.Rows.Count
    mydate = wsEarnings.Cells(i, 1): endFlg = False
    
    '祝日の処理
    If WorksheetFunction.CountIf(wsPublicHoliday.Columns(1), wsEarnings.Cells(i, 1)) > 0 Then
        '祝日書込み処理
        If writeHolidays_IX = 1 Then
            For k = 1 To wsEarnings.Range("A1").CurrentRegion.Columns.Count
                wswriteHolidays.Cells(writeHolidays_IX, k) = wsEarnings.Cells(1, k)
            Next
        End If
        
        writeHolidays_IX = writeHolidays_IX + 1 '書込み変数インクリメント
        
        For k = 1 To wsEarnings.Range("A1").CurrentRegion.Columns.Count
            wswriteHolidays.Cells(writeHolidays_IX, k) = wsEarnings.Cells(i, k)
        Next
        
        endFlg = True
    End If
    
    
    '平日、土日の処理
    If endFlg = False Then
        Call 書込み処理
    End If
Next


End Sub

サブルーチン、書込み処理

Private Sub 書込み処理()

If Weekday(mydate) = 7 Or Weekday(mydate) = 1 Then
    '休日書込み処理
    If writeHolidays_IX = 1 Then
        For k = 1 To wsEarnings.Range("A1").CurrentRegion.Columns.Count
            wswriteHolidays.Cells(writeHolidays_IX, k) = wsEarnings.Cells(1, k)
        Next
    End If
    
    writeHolidays_IX = writeHolidays_IX + 1 '書込み変数インクリメント
    
    For k = 1 To wsEarnings.Range("A1").CurrentRegion.Columns.Count
        wswriteHolidays.Cells(writeHolidays_IX, k) = wsEarnings.Cells(i, k)
    Next
    
Else
    '平日書込み処理
    If wirteWeekdays_IX = 1 Then
        For k = 1 To wsEarnings.Range("A1").CurrentRegion.Columns.Count
            wswriteWeekdays.Cells(wirteWeekdays_IX, k) = wsEarnings.Cells(1, k)
        Next
    End If
    
    wirteWeekdays_IX = wirteWeekdays_IX + 1 '書込み変数インクリメント
    
    For k = 1 To wsEarnings.Range("A1").CurrentRegion.Columns.Count
        wswriteWeekdays.Cells(wirteWeekdays_IX, k) = wsEarnings.Cells(i, k)
    Next
    
End If

End Sub

修正点は２点です。
１点目は、祝日の判定処理をCountifに変更しました。
２点目は、休日、平日の書き込み処理をサブルーチン化しました。サブルーチン化すると、処理がサブルーチンのコードに移った時に、プロシージャレベルの変数の値は破棄されるため、書込み用の変数、Sheet用の変数、endFlgはモジュールレベルの変数としました。

ここまでやるなら、祝日の処理も書込み処理のサブルーチンの中に入れれば？？と思いましたが、時間がある時に修正したいと思います。
やはり、サブルーチン化するとメイン処理がすっきりと見えます。モジュールレベルの変数をどれにするかが悩ましいところではありますが(;^ω^)。

４　感想

コードの部品化（サブルーチン化）は、可読性をあげる、保守しやすくするために必要だと思っていますが、なかなか手を出せずにいたので今回で少しレベルが上がりました。もっと部品化して、可読性の高いコードを書いていこうと思います。

ではでは、この辺で(^^)/~~~

５　英語の勉強

売上：Earnings
平日：Weekdays
休日：Holiday
祝日：Public Holiday

（土日祝Sheetは「Holidays」と造語を使っております。）

この記事から得るもの

１ 今回のお題

２ 今回のお題の意図

３ 回答