予定表のひな型(VBA研究会議事録_05)

VBA研究会で論じられた内容を記録する議事録の5本目(2023/02/18開催分)です。前回の議事録はコチラになります。

hirocom777.hatenadiary.org

前回はフォルダーサイズの取得について取り組みました。

今回は予定表のひな型です。Excelで予定表を作ることは、よくある使い方です。ひな形の作成を自動化できると便利です。

今回は @FukucyndiP さんのコードを掲載します。

以下にサンプルご用意しました。参考にしてください。 drive.google.com

予定表のひな型

それでは今回のお題です。

  • シート「元テーブル」のA1セルに入力した整数値に応じて、1か月分の日付をA列に自動出力してください。
  • 日付はyyyy/mm/dd(曜日)の形式にしてください。
  • 自動出力された日付に応じて土日祝日の行を灰色に塗りつぶしてください。
  • 祝日一覧は別シート(シート「祝日一覧」)で参照できます。(https://www8.cao.go.jp/chosei/shukujitsu/gaiyou.html

シート「元テーブル」はこんな感じです。

シート「祝日一覧」は以下の様になっています。

コードは以下になります。シート「元テーブル」に記述されています。順を追ってみていきましょう。

入力の処理

WorksheetオブジェクトのChangeイベントを使って、入力内容に変更があった場合に処理しています。変更されたセルTargetのAddressで確認できるので、A1セルが変更になった時のみ処理が実行されます。入力からイベント処理を実行させたい場合は、この方法が有効です。 Changeイベントはセルの値が変更になるたびに発生します。すると、全体の処理速度が落ちてしまいます。そこで、カレンダー日付作成等の処理をしている間は「Application.EnableEvents = False」として、イベントの発生を無効にしています。処理が完了したら「Application.EnableEvents = True」として、イベントの発生を有効に戻しておきましょう。

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$A$1" Then
        Application.EnableEvents = False
        Call カレンダー日付作成
        Call 休日塗り
        Application.EnableEvents = True
    End If
    
End Sub

日付の作成

上のプロシージャで実行される処理のうち、日付表示の処理を実行します。初日(initDay)は指定した月の1日、最終日は指定した月の次の月で日付を0に指定することで 取得できます。日付の曜日表記ですが、NumberFormatLocalで「aaa」と表示すればいいですね。

Sub カレンダー日付作成()
    
    With Me
        .Range("A3:A33").ClearContents
        Dim initDay As Date
        Dim lastDay As Date
        initDay = CDate(Year(Date) & "/" & .Range("A1").Value & "/" & 1)
        lastDay = DateSerial(Year(initDay), Month(initDay) + 1, 0)
         
        Dim i As Long: i = 0
        Do While i < lastDay - initDay + 1
            With .Range("A3").Offset(i, 0)
                .Value = initDay + i
                .NumberFormatLocal = "yyyy/mm/dd(aaa)"
            End With
            i = i + 1
        Loop
        
    End With

End Sub

休日の塗りつぶし

続いて土日祝日行の灰色塗りつぶしです。表示範囲(Me.Range("A3:E33"))のそれぞれの行の先頭を、関数isHolidayで判定して休日のみ塗りつぶしています。

Sub 休日塗り()
    'A列が休日なら、表の行全体を塗りつぶす
    Me.Range("A3:E33").Interior.Color = xlNone
    
    Dim tempRow As Range
    For Each tempRow In Me.Range("A3:E33").Rows
        If Not tempRow.Cells(1).Value = "" Then
            If isHoliday(tempRow.Cells(1).Value) Then
                tempRow.Interior.Color = rgbGray
            End If
        End If
    Next

End Sub

休日の判定

最後に上で使用している休日判定の関数です。日付データをFormat関数で「aaa」と指定することで曜日を取得できます。また、ExcelのCountIf関数を使用してシート「祝日一覧」に記載のある日付かどうかを確認することで祝日を判定しています。

Function isHoliday(ByVal targetDay As Date) As Boolean

    Dim ret As Boolean: ret = False
    If Format(targetDay, "aaa") Like "[土日]" _
       Or WorksheetFunction.CountIf(Sheets("祝日一覧").Range("B:B"), targetDay) = 1 Then
       
        ret = True
    End If
    
    isHoliday = ret

End Function

次回はExcelAPI

いかがでしょうか。この様に1つシステマチックな例を作っていくと、色々応用が利きます。慣れてきたら色々な機能拡張をしてみるといいかもしれません。 今回の課題に取り組む中で、ExcelAPIというサービスを見つけました。色々な機能かあるのですが、次回はこの機能を使って年間の休日情報を取得してみましたのでご紹介します。お楽しみに!!

hirocom777.hatenadiary.org

VBA研究会議事録まとめはこちらから