祝祭日を判定するには
Excelでは曜日の判定は出来ますが祝日の判定は出来ないため、祝祭日の情報をなんらかの方法で参照する必要があります。
一般的なのは祝祭日シートを用意したりネット情報を参照する方法だと思いますが、メンテナンスが面倒だったりフォーマットを考えないといけないなど、結構面倒です。
そこで、国が管理しているWebサイトから祝祭日の情報(CSVファイル)を得ることにします。一応国がやってるのでそこそこ安心できるかと思います。
内閣府の「国民の祝日」サイトで去年、今年、来年の3年分の祝祭日の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ファイルでしたが、現在は以下のように「日付」と「祝祭日名」の2列になっています。
事前設定
以下のソースコードは連想配列のDictionaryクラスとFileSystemObjectクラスを利用しています。
VBA画面のツールメニュー→参照設定でMicrosoft Scripting Runtimeにチェックを付けておく必要があります。
処理概要
祝祭日と土日に色を付ける処理の概要は以下になります。
なお、事前にセルに日付を入力してカレンダー等の用意は手作業になります。個別にフォーマットがあると思うのでここは省略しています。
- CSVファイルのダウンロードを行う。
- CSVファイルの内容を保持する。
- 日付が祝祭日や土日か判定して色を付ける。
- 上記処理を呼び出すメイン処理。
CSVファイルには2種類ありますが、祝祭日+振替休日等が網羅されているファイルの方をソースコードでは使っています。
既にダウンロード済みの場合は、メイン処理でのダウンロード処理の呼び出しの117行目をコメントアウトしてください。
1. CSVファイルのダウンロード処理
VBAでインターネットからファイルをダウンロードする方法には2通りあります。
1つは事前にセルにCSVファイルへのURLにハイパーリンクを設定しておいて、Hyperlink.Followメソッドでダウンロードする方法です。ただこの方法は既定ブラウザが起動してしまう点があります。「VBAでハイパーリンクを実行する」に詳細を書いています。
もう1つはVBAから直接インターネットのファイルをダウンロードする方法です。「VBAでインターネットからファイルをダウンロードする」に詳細を書いています。
ここでは2つ目の方法でCSVファイルをダウンロードします。ダウンロード先のフォルダは「C:\Download」とします。
ダウンロード処理はソースコードの1行目から35行目の部分になります。
3行目から19行目はWin32APIの部分になります。ソースをカスタマイズする場合も各関数よりも上に配置してください。
2. CSVファイルの内容を保持する処理
CSVファイルの内容はDictionaryオブジェクトに格納します。
ソースコードの37行目から59行目のGetCsvData関数の部分です。
ダウンロードしたCSVファイルの1行ずつ読み込み、カンマ編集されている左右の日付を祝祭日名称をDictionaryオブジェクトのキーと値として以下のように登録しています。
キー:2018-01-01、値:元日
キー:2018-01-08、値:成人の日
CSVファイルの1行目の見出し部分の「国民の祝日・休日月日,国民の祝日・休日名称」は処理(祝祭日かどうかの判定)には使いませんが処理に支障はないのでそのまま登録しています。
3. 日付が祝祭日や土日か判定して色を付ける処理
セルの日付が祝祭時や土日の場合に背景色を設定する処理が61行目から104行目になります。
ここではセル範囲の1セルずつに入力されている内容が日付かどうかを判定し、日付であれば日曜日、土曜日、振替休日等の休日、祝祭日、の順に判定を行って背景色を設定しています。
背景色はそれっぽい色にしています。他の色にしたい場合は「VBAでWebカラーCSS3の147色を指定する」にRGB値を書いていますので参考にしてください。
この関数で1つ考慮が必要な点があります。
それはCSVファイルの日付が「yyyy-mm-dd」とハイフン区切りなのに対して、セルのvalue値である日付のフォーマットは「yyyy/mm/dd」とスラッシュ区切りになっている点です。
そのためCSVファイルに合わせてセルの値をハイフン区切りに編集して事前にCSVファイルの内容を取得しているDictionaryオブジェクトから日付の検索を行うようにしています。
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 |
Option Explicit '// 指定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) '// 指定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 |
利用例
セルのフォーマットはカレンダー形式のフォーマットを事前に用意しています。表示上は書式設定で12/31や1などになっていますが、値は2017/12/31や2018/1/1などの日付が設定されています。
実行前(B列からH列を選択)
実行後(わかりやすいように選択状態ははずしています)
参考として、CSVファイルの対象年部分は以下になります。