[Excel VBA] 祝日を求めるサンプル

VBAマクロでカレンダ

ExcelのVBAマクロを使って簡単なカレンダを作ってみたので、備忘録として残しておきます。

VBAマクロでカレンダ
 

カレンダを作るためには、主に以下のような処理が必要。
・曜日を求める
・その月の最終日を求める(特に2月の閏年計算)
・祝日、休日などを求める
 - 固定日(毎年変わらない祝日)
 - ハッピーマンデー(第〇月曜日)
 - 振替休日
 - 春分の日、秋分の日(毎年変わるが計算で求められる)
 - 国民の休日(祝日で挟まれた日)

で、厄介なのが例えば祝日は、今後も変わる可能性があること。
例えば、
・5/1の「即位の日」、10/22の「即位礼正殿の儀」は2019年のみ
・「海の日」は10月第三週月曜日(ハッピーマンデー)だが、2020年(オリンピック)のみ7/23に移動
・「スポーツの日(体育の日)」は10月第二週月曜日(ハッピーマンデー)だが、2020年のみ7/24に移動
・「山の日」は8/11だが、2020年のみ8/10に移動
・2019年、旧「天皇誕生日」は廃止
・2020年から「天皇誕生日」は2/23
など。
 

要するに、これらは、直近にならないと分からないもの。
プログラム的にずっと変更無く使えるものではない。
ので、これらはハードコーディングせず、設定変更できる仕組みを用意していた方が望ましい。

今回はそこら辺を考慮し、休日設定用のExcelシートを用意し、そこで設定可能とした。

  • 休日設定
    分類 祝日、休日名 備考
    祝日(固定日) 1 1 元旦  
    祝日(ハッピーマンデー) 1 2 成人の日  
    祝日(固定日) 2 11 建国記念の日  
    祝日(固定日) 2 23 天皇誕生日 2020年から
    祝日(計算) 3 春分の日  
    祝日(固定日) 4 29 昭和の日  
    祝日(固定日) 5 3 憲法記念日  
    祝日(固定日) 5 4 みどりの日  
    祝日(固定日) 5 5 こどもの日  
    祝日(ハッピーマンデー) 7 3 海の日  
    祝日(固定日) 8 11 山の日  
    祝日(ハッピーマンデー) 9 3 敬老の日  
    祝日(計算) 9 秋分の日  
    祝日(ハッピーマンデー) 10 2 体育の日 2020年から「スポーツの日」に改名予定
    祝日(固定日) 11 3 文化の日  
    祝日(固定日) 11 23 勤労感謝の日  
    祝日(固定日) 2019 5 1 即位の日  
    祝日(固定日) 2019 10 22 即位礼正殿の儀  
    祝日(固定日) 2020 7 23 海の日 2020年のみ「海の日」を7/23に変更
    解除 2020 7 20
    祝日(固定日) 2020 7 24 スポーツの日 2020年のみ「スポーツの日」を7/24に変更
    解除 2020 10 12
    祝日(固定日) 2020 8 10 山の日 2020年のみ「山の日」を8/10に変更
    解除 2020 8 11
    祝日(固定日) 2021 7 22 海の日 2020年のみ「海の日」を7/22に変更
    解除 2021 7 19
    祝日(固定日) 2021 7 23 スポーツの日 2020年のみ「スポーツの日」を7/23に変更
    解除 2021 10 11
    祝日(固定日) 2021 8 8 山の日 2020年のみ「山の日」を8/8に変更
    解除 2021 8 11
    会社独自休日 12 31 冬休み 会社独自の休日設定など

 

それと、どうせ祝日求めるのなら、会社でよく使いそうな以下の機能も用意。

  • 休日 or 営業日かを確認

    休日 or 営業日かを確認

  • 前後の営業日を確認
    前後の営業日を確認
     前日営業日なども求められるように。
     例えば、2019/5/7の1営業日前は、ゴールデンウィーク10連休前の4/26。など。

  • 第〇営業日を確認
    第〇営業日を確認

  • 1年分のカレンダを表示
    1年分のカレンダを表示
    1年分のカレンダを表示

 

ソースコード

'Option Explicit

Sub 休日or営業日確認ボタン_Click()
    Dim targetDate As Date
    Dim res As String
    targetDate = Range("確認!C2").Text
    res = getHolidayName(targetDate)
    If res = "" Then
        res = "営業日"
    End If
    MsgBox _
        Year(targetDate) & "年" & _
        Month(targetDate) & "月" & _
        Day(targetDate) & "日" & _
        "・・・" & res
End Sub

Sub 前後営業日確認ボタン_Click()
    Dim targetDate As Date
    Dim sa As Integer
    targetDate = Range("確認!C5").Text
    sa = CInt(Range("確認!C6").Text)
    
    MsgBox getEigyobiByDay(targetDate, sa)
End Sub

Sub 第〇営業日確認ボタン_Click()
    Dim targetDate As Date
    Dim eigyobi As Integer
    targetDate = Range("確認!C9").Text
    eigyobi = CInt(Range("確認!C10").Text)
    
    MsgBox getDaiNEigyobi(Year(targetDate), Month(targetDate), eigyobi)
End Sub

Sub カレンダ表示ボタン_Click()
    Dim targetDate As Date
    Dim wDay() As Variant
    Dim yyyy As String
    Dim idx, m, d As Integer
    
    wDay = Array("日", "月", "火", "水", "木", "金", "土")
    yyyy = Range("確認!C13").Text
    
    ' 前回の表示クリア
    Range("確認!B14:C379") = ""
    
    idx = 13
    For m = 1 To 12
        For d = 1 To getLastDay(Int(yyyy), Int(m))
            idx = idx + 1
            targetDate = m & "/" & d & "/" & yyyy
            Range("確認!B" & idx) = _
                Year(targetDate) & "/" & _
                Month(targetDate) & "/" & _
                d & "(" & wDay(Weekday(targetDate) - 1) & ")"
            Range("確認!C" & idx) = getHolidayName(targetDate)
        Next d
    Next m
End Sub



' 指定日の祝日または、休日名を返す
'   ymd   ・・・調べたい日付
'   返却値・・・祝日名または会社独自休日の名前を返す
'               営業日の場合は""を返す
Function getHolidayName(ymd As Date)
    Dim result As String
    ' 会社独自休日を確認
    result = getPrivateHolidayName(ymd)
    If result = "" Then
        ' 祝日などを確認
        result = getPublicHolidayName(ymd, 0)
    End If
    ' 祝日名または、会社独自休日名
    getHolidayName = result
End Function

' 指定日の祝日名を返す
'   ymd     ・・・調べたい日付
'   saikiCnt・・・関数内から再帰呼び出しされた回数(階層数)
'   返却値  ・・・祝日名を返す
'                 土日の場合は曜日名を返す
'                 ※営業日の場合は""を返す
Function getPublicHolidayName(ymd As Date, saikiCnt As Integer)
    Dim idx, i, hm, sDay, zenjitsu, weekCnt, lastDay As Integer
    Dim t, y, m, d, w, n, wkDate, res, yokujitsu, result As String
    Dim yFlg As Boolean
    result = ""
    
    ' [休日設定]シートの3行目から順に祝日を確認
    idx = 3
    Do While (True)
        t = Range("休日設定!B" & idx).Text ' 分類
        y = Range("休日設定!C" & idx).Text ' 年
        m = Range("休日設定!D" & idx).Text ' 月
        d = Range("休日設定!E" & idx).Text ' 日
        w = Range("休日設定!F" & idx).Text ' 週
        n = Range("休日設定!G" & idx).Text ' 名前
        
        ' F列(分類)が未設定の場合、定義が終わりとみなしループを抜ける
        If t = "" Then Exit Do
        
        ' 月が一致?
        If Month(ymd) = CInt(m) Then
            Select Case t
                Case "祝日(固定日)"
                    ' 日が一致?
                    If Day(ymd) = CInt(d) Then
                        '未設定(毎年)または、年が一致?
                        If y = "" Then
                            result = n
                        ElseIf Year(ymd) = CInt(y) Then
                            result = n
                        End If
                    End If
                Case "祝日(ハッピーマンデー)"
                    ' 月の最終日を求める
                    weekCnt = 0
                    lastDay = getLastDay(Year(ymd), Month(ymd))
                    For i = 1 To lastDay
                        wkDate = Month(ymd) & "/" & i & "/" & Year(ymd)
                        ' 月曜日?
                        If Weekday(wkDate) = vbMonday Then
                            ' 第〇週月曜日かカウント
                            weekCnt = weekCnt + 1
                        End If
                        ' 第〇週が指定値と一致?
                        If CInt(weekCnt) = w Then
                            ' 日にちが一致?
                            If Weekday(wkDate) = vbMonday Then
                                ' ハッピーマンデーと判定
                                hm = i
                                Exit For
                            End If
                        End If
                    Next i
                    If hm = Day(ymd) Then
                        result = n
                    End If
                Case "祝日(計算)"
                    Select Case Month(ymd)
                        Case 3
                            ' 3月の場合、春分の日を計算
                            sDay = Int(20.8431 + 0.242194 * (Year(ymd) - 1980)) - Int((Year(ymd) - 1980) / 4)
                            If sDay = Day(ymd) Then
                                result = n
                            End If
                        Case 9
                            ' 9月の場合、秋分の日を計算
                            sDay = Int(23.2488 + 0.242194 * (Year(ymd) - 1980)) - Int((Year(ymd) - 1980) / 4)
                            If sDay = Day(ymd) Then
                                result = n
                            End If
                        Case Else
                            result = "エラー:" & idx & "行目の分類に誤りがあります。(分類で計算を指定した場合、3月または、9月のみ指定可能)"
                    End Select
                Case "会社独自休日"
                    ' この時点では会社独自休日の設定は行わない
                Case "解除"
                    ' この時点では休日解除しない
                Case Else
                    result = "エラー:" & idx & "行目の分類に誤りがあります。"
            End Select
        End If
        If result <> "" Then Exit Do
        idx = idx + 1
    Loop
    
    ' 国民の休日(休日に挟まれた日)を確認
    If saikiCnt <= 1 Then
        If result = "" Then
            zenjitsu = getPublicHolidayName(ymd - 1, saikiCnt + 1)
            If zenjitsu <> "" And zenjitsu <> "土曜日" And zenjitsu <> "日曜日" Then
                yokujitsu = getPublicHolidayName(ymd + 1, saikiCnt + 1)
                If yokujitsu <> "" And yokujitsu <> "土曜日" And yokujitsu <> "日曜日" Then
                    result = "国民の休日"
                End If
            End If
        End If
    End If
    
    
    ' 振替休日か調べる
    If saikiCnt = 0 Then
        If result = "" Then
            Dim wkYmd As Date
            wkYmd = ymd - 1
            Do While (True)
                ' 1日前が祝日か調べる
                res = getPublicHolidayName(wkYmd, saikiCnt + 1)
                If res <> "" And res <> "日曜日" Then
                    If Weekday(wkYmd) = vbSunday Then
                        Exit Do
                    Else
                        wkYmd = wkYmd - 1
                    End If
                Else
                    Exit Do
                End If
            Loop
            ' 祝日を遡った日が日曜日だった場合、振替休日扱いとする
            If Weekday(wkYmd) = vbSunday Then
                If res <> "日曜日" Then
                    result = "振替休日"
                End If
            End If
        End If
    End If
    
    ' 土日か調べる
    If result = "" Then
        If Weekday(ymd) = vbSaturday Then
            result = "土曜日"
        ElseIf Weekday(ymd) = vbSunday Then
            result = "日曜日"
        End If
    End If
    
    idx = 3
    Do While (True)
        t = Range("休日設定!B" & idx).Text ' 分類
        y = Range("休日設定!C" & idx).Text ' 年
        m = Range("休日設定!D" & idx).Text ' 月
        d = Range("休日設定!E" & idx).Text ' 日
        n = Range("休日設定!G" & idx).Text ' 名前
        
        ' C列(月)が数字以外の場合、定義が終わりとみなしループを抜ける
        If Not IsNumeric(m) Then Exit Do
        
        If t = "解除" Then
            ' 年が毎年(省略)、または、年が一致か調べる
            yFlg = False
            If y = "" Then
                yFlg = True
            ElseIf Year(ymd) = CInt(y) Then
                yFlg = True
            End If
            
            ' 年が該当するか?
            If yFlg Then
                ' 月が一致?
                If Month(ymd) = CInt(m) Then
                    ' 日が一致?
                    If Day(ymd) = CInt(d) Then
                        ' 休日を解除する
                        result = ""
                        Exit Do
                    End If
                End If
            End If
        End If
        idx = idx + 1
    Loop
    
    getPublicHolidayName = result
End Function

' 指定日が会社独自休日か名前を返す
'   ymd   ・・・調べたい日付
'   返却値・・・会社独自休日名を返す
'               営業日の場合は""を返す
Function getPrivateHolidayName(ymd As Date)
    Dim idx As Integer
    Dim t, y, m, d, n, result As String
    result = ""
    
    idx = 3
    Do While (True)
        t = Range("休日設定!B" & idx).Text ' 分類
        y = Range("休日設定!C" & idx).Text ' 年
        m = Range("休日設定!D" & idx).Text ' 月
        d = Range("休日設定!E" & idx).Text ' 日
        n = Range("休日設定!G" & idx).Text ' 名前
        
        ' C列(月)が数字以外の場合、定義が終わりとみなしループを抜ける
        If Not IsNumeric(m) Then Exit Do
        
        If t = "会社独自休日" Then
            ' 月が一致?
            If Month(ymd) = CInt(m) Then
                ' 日が一致?
                If Day(ymd) = CInt(d) Then
                    ' 未設定(毎年)または、年が一致か?
                    If y = "" Then
                        result = n
                    ElseIf Year(ymd) = CInt(y) Then
                        result = n
                    End If
                End If
            End If
        End If
        idx = idx + 1
    Loop
    
    getPrivateHolidayName = result
End Function

' 指定した月の最終日を返す
'   y・・・年
'   m・・・月
'   返却値・・・その月の最終日
'   例)getLastDay(2020,2)・・・29を返す
Function getLastDay(y As Integer, m As Integer)
    Dim result As Integer
    Select Case m
        Case 1, 3, 5, 7, 8, 10, 12
            result = 31
        Case 4, 6, 9, 11
            result = 30
        Case 2
            ' 2月の場合、閏年確認
            If y Mod 4 = 0 Then
                If y Mod 100 = 0 Then
                    If y Mod 400 = 0 Then
                        result = 29
                    Else
                        result = 28
                    End If
                Else
                    result = 29
                End If
            Else
                result = 28
            End If
        Case Else
            MsgBox "指定誤りがあります。" & vbCrLf & "getLastDay(" & y & "," & m & ")"
    End Select

    getLastDay = result
End Function

' 前後の営業日を確認
'   ymd・・・対象日
'   sa ・・・対象日からの差(営業日)
'   返却値・・・日にち(営業日)を返す
'
'  例)2019/5/7の2営業日前
'      getEigyobiByDay("05/07/2019",-2)
'      ⇒ゴールデンウィーク前の2019/4/26を返す
Function getEigyobiByDay(ymd As Date, sa As Integer)
    Dim cnt As Integer
    cnt = 0
    Do While (True)
        ' ターゲット日を1日移動
        If sa < 0 Then
            ymd = ymd - 1
        ElseIf sa > 0 Then
            ymd = ymd + 1
        Else
            Exit Do
        End If
        
        ' ターゲット日が営業日か?
        If getHolidayName(ymd) = "" Then
            ' 営業日カウント
            cnt = cnt + 1
        End If
        ' 指定した営業日カウントに達した場合、ループを抜ける
        If Abs(sa) = cnt Then Exit Do
    Loop
    
    getEigyobiByDay = ymd
End Function

' 第〇営業日を調べる
'   y   ・・・対象年
'   m   ・・・対象月
'   eigyobi・・・月初から何日目の営業日を求めるかをすうちで指定
'   返却値・・・日にち(営業日)を返す。異常値の場合、何も返却しない
Function getDaiNEigyobi(y As Integer, m As Integer, eigyobi As Integer)
    Dim i, cnt As Integer
    Dim res As String
    Dim ymd As Date
    For i = 1 To getLastDay(y, m)
        ymd = m & "/" & i & "/" & y
        res = getHolidayName(ymd)
        If res = "" Then
            ' 営業日(休日名無し)の場合、カウントアップ
            cnt = cnt + 1
        End If
        
        ' 指定した営業日とカウントが一致した場合、ループを抜ける
        If eigyobi = cnt Then Exit For
    Next i
    If eigyobi = cnt Then
        getDaiNEigyobi = ymd
    End If
End Function

ダウンロード

バージョン 公開日 サイズ ファイル カウンタ
1.01 2020/12/19 36.17 KB sample_vba_101.zip 1,521
1.00 2019/05/25 42.88 KB sample_vba.zip 952

 
更新履歴

・ver1.01 2021年カレンダに対応

・Ver1.00 初版

 
 
 

そして、カレンダ繋がりで、独り言。
ここのところ更新をさぼっていたように見えるプチカレンダについて、実はコツコツ作ってます。
今、公開中のプチカレンダ Ver2.17は、とても古い開発環境(VB6)で作っていたため、もう保守できない状態。。
なので、2年ぐらい前から、新しい開発環境(C#)でゼロから作り直しています。
本当は、元号が変わるタイミングで公開したかったのですが、大幅に遅れて実現できませんでした。
年内目標で完成できれば良いかなと思っています。
プチカレンダ

 
 
 

一応、現状のプチカレンダVer2でも、Windows Updateすることによって
「平和」⇒「令和」表示になります。

 
 
 

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

CAPTCHA


*