祝祭日を判定するには
Excelでは曜日の判定は出来ますが祝日の判定は出来ないため、祝祭日の情報をなんらかの方法で参照する必要があります。
一般的なのは祝祭日シートを用意したりネット情報を参照する方法だと思いますが、メンテナンスが面倒だったりフォーマットを考えないといけないなど、結構面倒です。
そこで、国が管理しているWebサイトから祝祭日の情報（CSVファイル）を得ることにします。一応国がやってるのでそこそこ安心できるかと思います。私が知る限り２回フォーマットが変わりましたが、今は扱いやすくなっています。
内閣府の「国民の祝日」サイトで1955年から現在までの祝祭日と振替休日のCSVファイルが配布されています。文字コードはShift-JISです。
https://www8.cao.go.jp/chosei/shukujitsu/gaiyou.html
「国民の祝日」のみのCSV（2KB）
https://www8.cao.go.jp/chosei/shukujitsu/syukujitsu.csv
URLが「shukujitsu」と「syukujitsu」と違うというのがURLが変わったりしそうでいまいち不安ですが、そこはスルーします。
以前はフォーマットが悪く使いにくかったり、３年分しかなかったりと使い勝手が悪いCSVファイルでしたが、現在は以下のように「日付（yyyy/m/dフォーマット）」と「祝祭日名」の２列になって扱いやすくなっています。なお、振替休日は「休日」と２文字で書かれています。
事前設定
以下のソースコードは連想配列の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/1/1、値：元日
キー：2018/1/8、値：成人の日
CSVファイルの１行目の見出し部分の「国民の祝日・休日月日,国民の祝日・休日名称」は処理（祝祭日かどうかの判定）には使いませんが処理に支障はないのでそのまま登録しています。
3. 日付が祝祭日や土日か判定して色を付ける処理
セルの日付が祝祭時や土日の場合に背景色を設定する処理が61行目から104行目になります。
ここではセル範囲の１セルずつに入力されている内容が日付かどうかを判定し、日付であれば日曜日、土曜日、振替休日等の休日、祝祭日、の順に判定を行って背景色を設定しています。
背景色はそれっぽい色にしています。他の色にしたい場合は「VBAでWebカラーCSS3の147色を指定する」にRGB値を書いていますので参考にしてください。
この関数で１つ考慮が必要な点があります。
それはCSVファイルの日付が「yyyy-mm-dd」とハイフン区切りなのに対して、セルのvalue値である日付のフォーマットは「yyyy/mm/dd」とスラッシュ区切りになっている点です。そのためCSVファイルに合わせてセルの値をハイフン区切りに編集して事前にCSVファイルの内容を取得しているDictionaryオブジェクトから日付の検索を行うようにしています。
（2021/10/15更新。yyyy-mm-ddのフォーマットではなくyyyy/m/dフォーマットに変わっているためハイフンとスラッシュの編集は対応不要になりました。下のコードも対応済みです）
4. メイン処理
106行目から124行目がメイン処理になり、上記の各処理の呼び出しを行っています。
このSetColorMain関数を実行すると選択セル範囲の土日と祝祭日と振替休日等の背景色が設定されます。
土日の背景色の設定のあとに祝祭日の設定を行っているため、日曜日で祝祭日の部分は祝祭日の色になります。
ソースコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 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 125 |
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/m/d） 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, "/", "-") key = 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 = "https://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ファイルの対象年部分は以下になります。
