VBAで祝祭日と土日に色を付ける

祝祭日を判定するには

Excelでは曜日の判定は出来ますが祝日の判定は出来ないため、祝祭日の情報をなんらかの方法で参照する必要があります。

一般的なのは祝祭日シートを用意したりネット情報を参照する方法だと思いますが、メンテナンスが面倒だったりフォーマットを考えないといけないなど、結構面倒です。

そこで、国が管理しているWebサイトから祝祭日の情報（CSVファイル）を得ることにします。一応国がやってるのでそこそこ安心できるかと思います。

内閣府の「国民の祝日」サイトで去年、今年、来年の３年分の祝祭日のCSVファイルが配布されています。祝祭日のみのCSVと祝祭日＋振替休日などのCSVです。文字コードはShift-JISです。
http://www8.cao.go.jp/chosei/shukujitsu/gaiyou.html

「国民の祝日」のみのCSV（2KB）
http://www8.cao.go.jp/chosei/shukujitsu/syukujitsu.csv

「国民の祝日」＋「振替休日などの休日」のCSV（2KB）
http://www8.cao.go.jp/chosei/shukujitsu/syukujitsu_kyujitsu.csv

URLが「shukujitsu」と「syukujitsu」と違うというのがURLが変わったりしそうでいまいち不安ですが、そこはスルーします。

以前はフォーマットが悪く使いにくいCSVファイルでしたが、現在は以下のように「日付」と「祝祭日名」の２列になっています。

事前設定

以下のソースコードは連想配列のDictionaryクラスとFileSystemObjectクラスを利用しています。

VBA画面のツールメニュー→参照設定でMicrosoft Scripting Runtimeにチェックを付けておく必要があります。

処理概要

祝祭日と土日に色を付ける処理の概要は以下になります。

なお、事前にセルに日付を入力してカレンダー等の用意は手作業になります。個別にフォーマットがあると思うのでここは省略しています。

CSVファイルのダウンロードを行う。
CSVファイルの内容を保持する。
日付が祝祭日や土日か判定して色を付ける。
上記処理を呼び出すメイン処理。

CSVファイルには２種類ありますが、祝祭日＋振替休日等が網羅されているファイルの方をソースコードでは使っています。

既にダウンロード済みの場合は、メイン処理でのダウンロード処理の呼び出しの117行目をコメントアウトしてください。

1. CSVファイルのダウンロード処理

VBAでインターネットからファイルをダウンロードする方法には２通りあります。

１つは事前にセルにCSVファイルへのURLにハイパーリンクを設定しておいて、Hyperlink.Followメソッドでダウンロードする方法です。ただこの方法は既定ブラウザが起動してしまう点があります。「VBAでハイパーリンクを実行する」に詳細を書いています。

もう１つはVBAから直接インターネットのファイルをダウンロードする方法です。「VBAでインターネットからファイルをダウンロードする」に詳細を書いています。

ここでは２つ目の方法でCSVファイルをダウンロードします。ダウンロード先のフォルダは「C:\Download」とします。

ダウンロード処理はソースコードの1行目から35行目の部分になります。

3行目から19行目はWin32APIの部分になります。ソースをカスタマイズする場合も各関数よりも上に配置してください。

2. CSVファイルの内容を保持する処理

CSVファイルの内容はDictionaryオブジェクトに格納します。

ソースコードの37行目から59行目のGetCsvData関数の部分です。

ダウンロードしたCSVファイルの１行ずつ読み込み、カンマ編集されている左右の日付を祝祭日名称をDictionaryオブジェクトのキーと値として以下のように登録しています。

キー：2018-01-01、値：元日
キー：2018-01-08、値：成人の日

CSVファイルの１行目の見出し部分の「国民の祝日・休日月日,国民の祝日・休日名称」は処理（祝祭日かどうかの判定）には使いませんが処理に支障はないのでそのまま登録しています。

3. 日付が祝祭日や土日か判定して色を付ける処理

セルの日付が祝祭時や土日の場合に背景色を設定する処理が61行目から104行目になります。

ここではセル範囲の１セルずつに入力されている内容が日付かどうかを判定し、日付であれば日曜日、土曜日、振替休日等の休日、祝祭日、の順に判定を行って背景色を設定しています。

背景色はそれっぽい色にしています。他の色にしたい場合は「VBAでWebカラーCSS3の147色を指定する」にRGB値を書いていますので参考にしてください。

この関数で１つ考慮が必要な点があります。

それはCSVファイルの日付が「yyyy-mm-dd」とハイフン区切りなのに対して、セルのvalue値である日付のフォーマットは「yyyy/mm/dd」とスラッシュ区切りになっている点です。

そのためCSVファイルに合わせてセルの値をハイフン区切りに編集して事前にCSVファイルの内容を取得しているDictionaryオブジェクトから日付の検索を行うようにしています。

4. メイン処理

106行目から124行目がメイン処理になり、上記の各処理の呼び出しを行っています。

このSetColorMain関数を実行すると選択セル範囲の土日と祝祭日と振替休日等の背景色が設定されます。

土日の背景色の設定のあとに祝祭日の設定を行っているため、日曜日で祝祭日の部分は祝祭日の色になります。

ソースコード

Option Explicit

'// 64bit版
#If VBA7 And Win64 Then
    '// 指定URLファイルのダウンロード
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
    '// キャッシュクリア
    Private Declare Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
    '// スリープ
    Private Declare PtrSafe Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
'// 32bit版
#Else
    '// 指定URLファイルのダウンロード
    Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
    '// キャッシュクリア
    Private Declare Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
    '// スリープ
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

'// 指定URLファイルのダウンロードを行う
Sub DownloadFile(a_sUrl As String, a_sDir As String)
    Dim ret             '// 戻り値
    
    '// キャッシュクリア
    Call DeleteUrlCacheEntry(a_sUrl)
    
    '// ダウンロード
    ret = URLDownloadToFile(0, a_sUrl, a_sDir, 0, 0)
    
    '// ダウンロード失敗時
    If ret <> 0 Then
        Debug.Print a_sUrl & "：ダウンロード失敗"
    End If
End Sub

'// CSVデータ情報取得
Sub GetCsvData(sFilePath As String, map As Dictionary)
    Dim fs      As New FileSystemObject '// FileSystemObjectオブジェクト
    Dim ts      As TextStream           '// TextStreamオブジェクト
    Dim sLine                           '// 読み込み行
    Dim v                               '// 分割用
    
    '// CSVファイルを開く
    Set ts = fs.OpenTextFile(sFilePath, ForReading, False, TristateFalse)
    
    Do While ts.AtEndOfStream <> True
        '// 1行読み込み
        sLine = ts.ReadLine
        
        '// カンマで分割
        v = Split(sLine, ",")
        
        '// 日付(yyyy-mm-dd)をキー、祝祭日名を値として登録
        Call map.Add(v(0), v(1))
    Loop
    
    ts.Close
End Sub

'// 日付に背景色設定
Sub SetDayColor(map As Dictionary)
    Dim r           As Range    '// セル
    Dim key         As String   '// CSVファイルデータ検索キー（yyyy-mm-dd）
    Dim holidayName As String   '// CSVファイルの祝祭日名
    Dim week                    '// 曜日
    
    '// シート内の選択セルをループ
    For Each r In Selection
        '// 日付セルでない場合
        If (IsDate(r.value) = False) Then
            GoTo CONTINUE
        End If
        
        '// 曜日取得
        week = Weekday(r.value)
        
        '// 日曜日
        If (week = vbSunday) Then
            r.Interior.Color = RGB(255, 183, 192)
        '// 土曜日
        ElseIf (week = vbSaturday) Then
            r.Interior.Color = RGB(193, 193, 255)
        End If
        
        '// CSVファイルの日付形式に編集
        key = Replace(r.value, "/", "-")
        
        '// CSVファイルに対象日付が存在する場合
        If (map.Exists(key) = True) Then
            holidayName = map.Item(key)
            
            '// 振替休日、「国民の祝日」に挟まれた平日
            If (holidayName = "休日") Then
                r.Interior.Color = RGB(255, 192, 203)
            '// 祝祭日
            Else
                r.Interior.Color = RGB(255, 215, 0)
            End If
        End If
        
CONTINUE:
    Next
End Sub

'// 背景色設定メイン
Sub SetColorMain()
    Dim sUrl    As String           '// ダウンロード対象ファイルのURL
    Dim sDir    As String           '// ダウンロードファイルを保存するローカルPCのフォルダパス
    Dim map     As New Dictionary   '// Dictionaryクラスオブジェクト
    
    '// URL設定
    sUrl = "http://www8.cao.go.jp/chosei/shukujitsu/syukujitsu_kyujitsu.csv"
    sDir = "C:\web\Download\syukujitsu_kyujitsu.csv"
    
    '// CSVファイルダウンロード
    Call DownloadFile(sUrl, sDir)
    
    '// CSVデータ情報取得
    Call GetCsvData(sDir, map)
    
    '// 背景色設定
    Call SetDayColor(map)
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

Option Explicit

'// 64bit版

#If VBA7 And Win64 Then

'// 指定URLファイルのダウンロード

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

'// キャッシュクリア

Private Declare Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long

'// スリープ

Private Declare PtrSafe Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

'// 32bit版

#Else

'// 指定URLファイルのダウンロード

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

'// キャッシュクリア

Private Declare Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long

'// スリープ

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

#End If

'// 指定URLファイルのダウンロードを行う

Sub DownloadFile(a_sUrl As String, a_sDir As String)

Dim ret '// 戻り値

'// キャッシュクリア

Call DeleteUrlCacheEntry(a_sUrl)

'// ダウンロード

ret = URLDownloadToFile(0, a_sUrl, a_sDir, 0, 0)

'// ダウンロード失敗時

If ret <> 0 Then

Debug.Print a_sUrl & "：ダウンロード失敗"

End If

End Sub

'// CSVデータ情報取得

Sub GetCsvData(sFilePath As String, map As Dictionary)

Dim fs As New FileSystemObject '// FileSystemObjectオブジェクト

Dim ts As TextStream '// TextStreamオブジェクト

Dim sLine '// 読み込み行

Dim v '// 分割用

'// CSVファイルを開く

Set ts = fs.OpenTextFile(sFilePath, ForReading, False, TristateFalse)

Do While ts.AtEndOfStream <> True

'// 1行読み込み

sLine = ts.ReadLine

'// カンマで分割

v = Split(sLine, ",")

'// 日付(yyyy-mm-dd)をキー、祝祭日名を値として登録

Call map.Add(v(0), v(1))

Loop

ts.Close

End Sub

'// 日付に背景色設定

Sub SetDayColor(map As Dictionary)

Dim r As Range '// セル

Dim key As String '// CSVファイルデータ検索キー（yyyy-mm-dd）

Dim holidayName As String '// CSVファイルの祝祭日名

Dim week '// 曜日

'// シート内の選択セルをループ

For Each r In Selection

'// 日付セルでない場合

If (IsDate(r.value) = False) Then

GoTo CONTINUE

End If

'// 曜日取得

week = Weekday(r.value)

'// 日曜日

If (week = vbSunday) Then

r.Interior.Color = RGB(255, 183, 192)

'// 土曜日

ElseIf (week = vbSaturday) Then

r.Interior.Color = RGB(193, 193, 255)

End If

'// CSVファイルの日付形式に編集

key = Replace(r.value, "/", "-")

'// CSVファイルに対象日付が存在する場合

If (map.Exists(key) = True) Then

holidayName = map.Item(key)

'// 振替休日、「国民の祝日」に挟まれた平日

If (holidayName = "休日") Then

r.Interior.Color = RGB(255, 192, 203)

'// 祝祭日

Else

r.Interior.Color = RGB(255, 215, 0)

End If

CONTINUE:

End Sub

'// 背景色設定メイン

Sub SetColorMain()

Dim sUrl As String '// ダウンロード対象ファイルのURL

Dim sDir As String '// ダウンロードファイルを保存するローカルPCのフォルダパス

Dim map As New Dictionary '// Dictionaryクラスオブジェクト

'// URL設定

sUrl = "http://www8.cao.go.jp/chosei/shukujitsu/syukujitsu_kyujitsu.csv"

sDir = "C:\web\Download\syukujitsu_kyujitsu.csv"

'// CSVファイルダウンロード

Call DownloadFile(sUrl, sDir)

'// CSVデータ情報取得

Call GetCsvData(sDir, map)

'// 背景色設定

Call SetDayColor(map)

End Sub

利用例

セルのフォーマットはカレンダー形式のフォーマットを事前に用意しています。表示上は書式設定で12/31や1などになっていますが、値は2017/12/31や2018/1/1などの日付が設定されています。

実行前（B列からH列を選択）

実行後（わかりやすいように選択状態ははずしています）

参考として、CSVファイルの対象年部分は以下になります。

祝祭日を判定するには

事前設定

処理概要

1. CSVファイルのダウンロード処理

2. CSVファイルの内容を保持する処理

3. 日付が祝祭日や土日か判定して色を付ける処理

4. メイン処理

ソースコード

利用例

関連記事