国民の祝日を取得するエクセルマクロ(Excel VBA) | エクセルマクロ(VBA)実践蔵(じっせんぐら)

トップ項目一覧

祝日か判定し、祝日の名称を取得するマクロ

エクセルの下記図のような表をマクロで読み込み、祝日の名称を返すマクロを作成しました。

図にあるように、春分の日、秋分の日は、天文台からの発表によって日にちが前後するため、確定させられません。暫定で、春分の日を3/20、秋分の日を9/23に設定しています。そのため、春分の日が3/21日、秋分の日が9/22の場合に個別にその年限定の祝日として追加記述をしています。そのため、今後も春分の日、秋分の日を正しく表示させていくには、メンテナンスは必要です。

また、2020年以前の春分の日と秋分の日を正しく表示させたい方は、追加措置が必要です。

ここでは、2020年以降の春分の日と秋分の日だけ確認して記述しています。

実行結果例

セルからの呼び出しにも対応しました。

上の図では、標準モジュールの「祝日判定(日付)」をセルから呼び出しています。もちろん、マクロ内でも呼び出せます。戻り値は、祝日の名称です。祝日でなければ、空("")が返ります。

B列のセルB1には、「=TEXT(A1,"aaa")」が記述されていて、曜日を表示できます。(標準のエクセル関数)

このサイトのカレンダーにこのマクロを順次適応させていきたいと思っています。

マクロの解説

自作のセル関数「祝日判定」

セル関数と記載していますが、もちろんマクロ内でも呼び出せます。

標準モジュールにFunctionを記述して、Privateにしなければ、デフォルトがPublicなので、セルから呼び出せます。

 
Function 祝日判定(ChkDate As Date) As String 
     
    Dim result As String 
    Dim rsltBack As String 
    Dim rsltAfter As String 
    Dim rsltBack2 As String 
     
    '当日、前日、次の日が祝日表の祝日と比較し、一致するなら名前が返る 
    result = ThisWorkbook.Worksheets("国民の祝日").表判定(ChkDate) 
    rsltBack = ThisWorkbook.Worksheets("国民の祝日").表判定(ChkDate - 1) 
    rsltAfter = ThisWorkbook.Worksheets("国民の祝日").表判定(ChkDate + 1) 
     
    '戻り値へ初期値の設定 
    祝日判定 = "" 
     
    '振替判定 
    If ThisWorkbook.Worksheets("国民の祝日").Furikae適応(ChkDate) = True Then 
        If Weekday(ChkDate - 1) = vbSunday And rsltBack <> "" Then 
            'WeekDayは、曜日を数値で返す標準関数。前日が日曜かつ祝日の場合 
            If result = "" Then 
                '当日が祝日以外なら前日の祝日が当日に振替となる 
                祝日判定 = rsltBack & "振替" 
                Exit Function 
            End If 
         
        End If 
    End If 
     
    If result <> "" Then 
        '当日が祝日表と一致 
         
        祝日判定 = result 
        Exit Function 
     
    ElseIf rsltBack <> "" And rsltAfter <> "" Then 
        '前日と次の日が祝日表と一致 
         
        祝日判定 = "国民の休日" 
        Exit Function 
         
    End If 
     
    'ただの、念のため… 
    '振替判定 
    If ThisWorkbook.Worksheets("国民の祝日").Furikae適応(ChkDate) = True Then 
        If rsltBack <> "" Then 
            '前日が祝日 
            '前々日チェック 
            rsltBack2 = ThisWorkbook.Worksheets("国民の祝日").表判定(ChkDate - 2) 
             
            If rsltBack2 <> "" And Weekday(ChkDate - 2) = vbSunday Then 
                '日曜と祝日がぶつかり、次の月曜が祝日なら、火曜が祝日 
                祝日判定 = rsltBack2 & "振替" 
            End If 
             
        End If 
    End If 
         
End Function 
 

標準モジュール 祝日判定の解説

黄色の下線がついているメソッドは、以降のシートオブジェクトに記載しています。

判定したい日の前後の情報を取得して、振替の判定や、国民の休日(祝日と祝日に挟まれた平日)の判定を行っています。表判定は、祝日設定表から得られる祝日の名称を返してくれます。Furikae適応は、振替制度開始年度1973以降の日付かの判断です。

補足①：「ThisWorkbook.Worksheets("国民の祝日")」をWorkSheet型の変数に置き換えてから呼び出そうとしたら、セル関数としてセルから呼び出した場合にコンパイルエラーが発生しました。そのため、コードが長くなりますが置き換えずに「ThisWorkbook.Worksheets("国民の祝日")」としています。祝日一覧表のシートをコピーする際には、ご注意ください。シート名とオブジェクト名は異なりますので、プロジェクトエクスプローラから確認をしてください。

補足②：自作のセル関数を作成する場合、他のセルへの書き込みは禁止されているようです。エラーも発生することなく、突然実行が停止し、セルの値は「!VALUE」となってしまいました。

祝日設定表に関する情報を返す関数群

シートオブジェクト(祝日設定表の裏側)に記述します。

表に依存するコードなので、シートオブジェクトに記述します。シートオブジェクトは、シートコピーされると一緒にコピーされます。

 
Function StRow() As Long 
    '開始行 
    StRow = 4 
End Function 
 
Function 日付stRng() As Range 
    '日付先頭セル 
    Set 日付stRng = Range("D" & StRow) 
End Function 
 
Function EdRow() As Long 
    '最終行 
    EdRow = 日付stRng.End(xlDown).Row 
End Function 
 
Function 日付Rngs() As Range 
    '日付列すべて 
    Set 日付Rngs = Range(日付stRng, Cells(EdRow, 日付stRng.Column)) 
End Function 
 
Function stYearRng() As Range 
    '開始年先頭セル 
    Set stYearRng = Range("B" & StRow) 
End Function 
 
Function edYearRng() As Range 
    '終了年先頭セル 
    Set edYearRng = Range("C" & StRow) 
End Function 
     
Function HolNameRng() As Range 
    '祝日名の先頭セル 
    Set HolNameRng = Range("E" & StRow) 
End Function 
 
Function HolTypeRng() As Range 
    '種別先頭セル 
    Set HolTypeRng = Range("F" & StRow) 
End Function 
 
Function HappyMonRng() As Range 
    '月曜指定先頭セル 
    Set HappyMonRng = Range("G" & StRow) 
End Function 
 
Function FurikaeStYear() As Long 
    '振替適応開始年の取得 
    FurikaeStYear = Range("H4").Value 
     
End Function 
 
'振替適応年度判定 
Function Furikae適応(ChkDate As Date) As Boolean 
     
    If CLng(year(ChkDate)) >= FurikaeStYear Then 
        Furikae適応 = True 
    Else 
        Furikae適応 = False 
    End If 
     
End Function 

祝日設定表に関する情報を返す関数群の解説

表の配置変更があった場合に、修正箇所が少なくなるようにしています。

関数化しておくと、グローバル変数と違って、初期化処置が不要になります。

このマクロを実行して辿りたい人は、上の関数群に関しては、ステップ実行せずに、stepオーバー(Shift+F8)を使ってください。

月曜祝日の日にちを求めるエクセルマクロ

下記も、つづけて、シートオブジェクト(祝日設定表の裏側)に記述します。

 
 
'指定された年の月曜固定祝日の日にちを求める 
Function getMonHoliday(chkYear As Long, oneCell As Range) 
     
    Dim weekcnt As Long        '第〇週の数値 
    Dim fstDayWeek As Long     '月の先頭の曜日 
    Dim diff As Long           '月はじめの第1月曜までの端数 
    Dim MonthInfoStr As String 'セルの内容「〇月第〇」を格納する変数 
    Dim ArySplit 'Split用 
         
    MonthInfoStr = oneCell.Value 
    MonthInfoStr = Replace(MonthInfoStr, "月", "", , , vbTextCompare) 
     
    ArySplit = Split(MonthInfoStr, "第", , vbTextCompare) 
     
    MonthInfoStr = ArySplit(0) 
    '祝日の日を特定する 
    weekcnt = ArySplit(1) 
     
    fstDayWeek = Weekday(DateSerial(chkYear, Val(MonthInfoStr), 1)) 
    diff = (vbMonday + 7 - fstDayWeek) Mod 7 
    getMonHoliday = DateSerial(chkYear, Val(MonthInfoStr), 1 + diff + 7 * (weekcnt - 1)) 
     
End Function 
 

月曜祝日の日にちを求めるエクセルマクロの解説

「〇月第〇」という表の情報を解析するために、一旦「月」をReplaceで削除し、「第」を区切り文字として、split関数をしようします。区切り文字は削除され、ArySplit(0)に前半の月数が、ArySplit(1)に後半の第何週かの数値が格納されます。

Weekdayは標準関数で、曜日を数値で返します。vbMondayも標準で使用できますので、値を使用するよりは決められている名称を使用します。月の1日が何曜日から始まるか確認して、指定された週数分の日数とはじめの週の日曜までの日数を加算して、日にちを求めます。

祝日一覧の表から適応年度の取得するエクセルマクロ

下記も、つづけて、シートオブジェクト(祝日設定表の裏側)に記述します。

 
 
'祝日適応年度を表から取得 
Function 適応年度取得(aCell As Range, ByRef stYearL As Long, ByRef endYearL As Long) 
         
    '開始年と終了年の取得 
    stYearL = Cells(aCell.Row, stYearRng.Column).Text 
     
    If Cells(aCell.Row, edYearRng.Column).Text <> "" Then 
        '終了年設定あり 
        endYearL = Cells(aCell.Row, edYearRng.Column).Text 
    Else 
        '未設定 
        endYearL = 0 
    End If 
     
End Function 
 

祝日一覧の表から適応年度の取得マクロの解説

セルに表示されている日付を取得するため、RangeオブジェクトのTextメソッドを使用して、セルから日付を文字列として取得します。Valueを使用すると日付のシリアル値になる。

引数にByRefを設定すると、戻り値でなくても、関数内で設定した値を、呼び出した側で参照できます。C言語のポインタ渡しと同じ扱いです。

祝日名称の重複判定のエクセルマクロ

例外の年度対策で、ほぼオリンピック向けです。今後もあるかわからないので、対応しています。

 
'オリンピック例外対応 
'重複判定 重複なし False 重複あり Trueを返す 
Function 重複判定(chkName As String, GetList祝日名() As String) As Boolean 
     
    Dim setName 
    重複判定 = False 
     
    For Each setName In GetList祝日名 
         
        If StrComp(setName, chkName, vbTextCompare) = 0 Then 
            '一致する祝日は登録済み 
             
            重複判定 = True 
            Exit For 
             
        End If 
    Next 
             
End Function 

祝日名称の重複判定をおこなうエクセルマクロの解説

引数で配列と文字列chkNameを受け取り、配列内に同じ名前があるかの確認をしています。

表から得られる日付に対する祝日名を取得するエクセルマクロ

 
'祝日なら祝日名、祝日以外なら(空)""を返す 
Function 表判定(ChkDate As Date) As String 
     
    'ループ内表の日付欄のセル 
    Dim aCell As Range 
    Dim stYearL As Long   '祝日適応開始年度 
    Dim endYearL As Long  '祝日適応終了年度 
    Dim HolType As String '祝日種類 
     
    Dim GetYearHolName() As String '祝日名ダブりチェック用 
    Dim GetYearCnt As Long 
     
    Dim sDate As Date 'ループ内で表の祝日シリアル値 
    Dim setName 
    Dim chkName As String 
    Dim result As Boolean 
     
 
    表判定 = "" 
     
    GetYearCnt = 0 
    ReDim GetYearHolName(GetYearCnt + 1) 
     
    For Each aCell In 日付Rngs 
         
        '開始年度と終了年度を受け取る関数呼び出し 
        Call 適応年度取得(aCell, stYearL, endYearL) 
         
        If endYearL = 0 Then 
            endYearL = year(ChkDate) 
        End If 
         
        '休日種類別に判定すべき日付を求める 
        HolType = Cells(aCell.Row, HolTypeRng.Column) 
        If HolType = "限定" Then 
             
            '祝日判定日はセルの日付そのまま 
            sDate = aCell.Value 
        ElseIf HolType = "月曜固定" Then 
                 
            '月曜固定の祝日を取得 
            sDate = getMonHoliday(year(ChkDate), aCell) 
                   
        ElseIf HolType = "固定" Then 
         
            '祝日判定日は確認の年と月日を合わせる 
            sDate = year(ChkDate) & "/" & aCell.Value 
                                      
        End If 
         
        '年数の範囲チェック 
        If stYearL <= CLng(year(ChkDate)) And endYearL >= CLng(year(ChkDate)) Then 
         
            '同名の祝日は読み飛ばす 
            chkName = Cells(aCell.Row, HolNameRng.Column).Value 
             
            result = 重複判定(chkName, GetYearHolName) 
             
            '重複していない場合 
            If result = False Then 
             
                'チェック済み対象の祝日を登録する 
                GetYearHolName(GetYearCnt) = Cells(aCell.Row, HolNameRng.Column).Value 
                 
                '年度と祝日名かぶりをパスする 
                ReDim Preserve GetYearHolName(GetYearCnt + 1) 
                GetYearCnt = GetYearCnt + 1 
             
            End If 
             
            If result = False And ChkDate = sDate Then 
             
                表判定 = Cells(aCell.Row, HolNameRng.Column) 
                 
                Exit Function 
                 
            End If 
             
        End If 
    Next 
     
End Function 

表から得られる日付に対する祝日名を取得するエクセルマクロの解説

休日種類別に判定すべき日にち（祝日の日にち）を取得しています。

祝日一覧表の開始年と終了年の範囲内であるか確認する。範囲外は一切確認しない。

例外対策として、同じ年に同じ名称の祝日が記述されている場合、後半を判定外とするために、重複判定をおこなっています。そのために使用する配列は、「ReDim Preserve」を使用して追加がある度に再定義しています。「ReDim Preserve」は、配列の中身を維持して、領域の拡張ができます。(ReDimだけなら、中身が空に初期化される。)

「GetYearHolName」は宣言にあるように、配列です。関数ではありません。なるべく配列名には「Ary」を使っていますが、変数名が長くなるのでここでは使っていません。

エクセルマクロ有効ブックのダウンロード

ダウンロードしたエクセルファイルを起動し、コンテンツの有効化を行う。

マクロの有効化手順については、こちら「マクロの初期設定と基本」も参考にしてください。

祝日の名称を取得するエクセルマクロファイル(xlsm)のダウンロード

表の取得のみを希望の場合はこちらからどうぞ