Excelでよく見かけるのが祝日専用のシートに祝日一覧を記載してそれをカレンダー系のシートでvlookupなどで判定して祝日なら色付けするというような方法ですが、この祝日専用シートの祝日はネットで検索した情報などをコピペなどで手動設定しているケースが多いです。

今回はボタン2つで最新の祝日情報をExcelに表示するVBAのサンプルコードをご紹介します。

最新の祝日用のCSVファイルは内閣府が公開している最新の祝日ファイルを使用します。

• 内閣府のHPで公開しているCSVファイル

VBA サンプルコード「祝日CSVのダウンロード」

• 上記で照会した内閣府の祝日CSVファイルをダウンロードするVBAコードとなります。
  CSVダウンロード用

  Visual Basic

  'ダウンロード用API（引数：0,Urlリンク,フォルダー名,0,0）を受け取る 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 Option Explicit Sub csv_download_Click() Dim SUrl As String Dim Fol As String Dim Fname As String Dim SNow As String SNow = Replace(Time, ":", "_") Fol = "C:\" Fname = Fol & "祝日一覧.csv" '祝日一覧.csvとしてダウンロードします。 '日本の祝日CSVデータのリンク SUrl = "https://www8.cao.go.jp/chosei/shukujitsu/syukujitsu.csv" Dim ReturnF As Variant 'API関数を格納する変数 'ファイルをダウンロード・フォルダに格納 '第二引数にURL,第三引数に任意のフォルダーパス,その他の引数は0を渡します。 ReturnF = URLDownloadToFile(0, SUrl, Fname, 0, 0) If ReturnF <> 0 Then '失敗したら0以外の数値を返します。 MsgBox "失敗！" & ReturnF Exit Sub End If MsgBox "祝日CSVファイルをダウンロードしました。" End Sub

  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

  'ダウンロード用API（引数：0,Urlリンク,フォルダー名,0,0）を受け取る 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      Option Explicit   Sub csv_download_Click()     Dim SUrl As String     Dim Fol As String     Dim Fname As String     Dim SNow As String     SNow = Replace(Time, ":", "_")     Fol = "C:\"     Fname = Fol & "祝日一覧.csv" '祝日一覧.csvとしてダウンロードします。          '日本の祝日CSVデータのリンク     SUrl = "https://www8.cao.go.jp/chosei/shukujitsu/syukujitsu.csv"          Dim ReturnF As Variant 'API関数を格納する変数          'ファイルをダウンロード・フォルダに格納     '第二引数にURL,第三引数に任意のフォルダーパス,その他の引数は0を渡します。     ReturnF = URLDownloadToFile(0, SUrl, Fname, 0, 0)          If ReturnF <> 0 Then '失敗したら0以外の数値を返します。         MsgBox "失敗！" & ReturnF         Exit Sub     End If          MsgBox "祝日CSVファイルをダウンロードしました。" End Sub

   

VBA サンプルコード「ダウンロードしたCSVをExcelへ表示」

• ダウンロードしたCSVファイルを読み込んでExcelへ表示するVBAコードとなります。
  ダウンロードしたCSVをEXCELへ表示する

  Visual Basic

  Dim varFileName As Variant Dim intFree As Integer Dim strRec As String Dim strSplit() As String Dim row As Long Dim col As Long varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _ Title:="CSVファイルの選択") If varFileName = False Then Exit Sub End If intFree = FreeFile '空番号を取得 Open varFileName For Input As #intFree 'CSVファィルをオープン row = 3 Do Until EOF(intFree) Line Input #intFree, strRec '1行読み込み row = row + 1 strSplit = Split(strRec, ",") 'カンマ区切りで配列へ For col = 0 To UBound(strSplit) Cells(row, col + 1) = strSplit(col) Next Loop Close #intFree

  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

  Dim varFileName As Variant     Dim intFree As Integer     Dim strRec As String     Dim strSplit() As String     Dim row As Long     Dim col As Long       varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _                                                 Title:="CSVファイルの選択")     If varFileName = False Then         Exit Sub     End If       intFree = FreeFile '空番号を取得     Open varFileName For Input As #intFree 'CSVファィルをオープン        row = 3     Do Until EOF(intFree)         Line Input #intFree, strRec '1行読み込み         row = row + 1         strSplit = Split(strRec, ",") 'カンマ区切りで配列へ         For col = 0 To UBound(strSplit)             Cells(row, col + 1) = strSplit(col)         Next     Loop        Close #intFree

実行結果例