大半の市販のカレンダーには
祝日の情報が載ってます。
祝日は、こちらのWebページで分かります。
国立天文台トップページ ＞ 暦計 算室 ＞ 暦要項
2010年3月22日現在では、
2004年から2011年までの国民の祝日が掲載されています。
このページをWebクエリでExcelに取り込んで
使いやすいように加工します。
手順は、まず
Webクエリで必要な表だけ
Excelのシートの適当な場所に取り込みます。
それから、A列に日付け、B列に名称をコピペし、
コピー元のWebクエリは削除します。
日付はWebクエリで取り込んだままだと
文字列のままだったので
ひと手間かけてDate型にしました。
方法は下のコードを見てください。
問題は、振替休日と国民の休日を加えることです。
それぞれ別にFor文を使って調べていって
振替休日と国民の休日を追加しています。
とりあえず2004年から2011年までは
正確に振替休日と国民の休日を追加できました。
下のコードのWebクエリの部分ですが
マクロ自動記録で記録したものを
一部分だけ替えてそのまま使ってあるので
必要性のないプロパティなどあるかと思います。
コードはこちら
祝日を取得するコード：Sub macro100322a()
'GetHollydaysの使用例
'西暦4桁で年を指定する
Call GetHollydays(2010)
End Sub
Sub GetHollydays(Year1 As Integer)
'祝日を取得する
'新しいシートを作成してwebからデータを取り込む
'Year1を西暦4桁で年を指定する
With ActiveWorkbook.Worksheets
.Add.Name = "祝日" + CStr(Year1)
End With
Range("A1").Value = Year1 & "年の国民の休日"
Dim Year2 As String
Year2 = Right(Year1, 2)
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://eco.mtk.nao.ac.jp/koyomi/yoko/" & Year1 & _
"/rekiyou" & Year2 & "1.html", Destination:= _
Range("D1"))
.Name = "rekiyou091"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "1"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.nao.ac.jp/koyomi/yoko/" & Year1 & _
"/rekiyou" & Year2 & "1.html", Destination:= _
Range("G1"))
.Name = "rekiyou091"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.Refresh BackgroundQuery:=False
End With
'適当なセルからコピペ
Dim EndRow1, EndRow2 As Integer
EndRow1 = Range("D1").End(xlDown).Row
Range("D1:D" & EndRow1).Copy Range("B2")
Range("E1:E" & EndRow1).Copy Range("A2")
EndRow2 = Range("G1").End(xlDown).Row
Range("G2:G" & EndRow2).Copy Range("B" & EndRow1 + 2)
Range("H2:H" & EndRow2).Copy Range("A" & EndRow1 + 2)
Range("D1:H9").Delete
'表示形式を指定する
Columns(1).NumberFormat = "m月d日(aaa)"
'文字列の日付けをDate型にする
Dim i As Integer
For i = 3 To Range("A1").End(xlDown).Row
Range("A" & i).FormulaR1C1 = Range("A" & i) & Year1 & "年"
Next i
'列幅自動調整
Columns("A:B").EntireColumn.AutoFit
'振替休日チェック
Dim MyDate As Date
Dim j As Integer
j = 1
For i = 3 To 25
'Range("A" & i).Select
If Weekday(Range("A" & i)) = 1 Then
MyDate = Range("A" & i) + 1
Step1:
If MyDate = Range("A" & i + j) Then
MyDate = MyDate + 1
j = j + 1
GoTo Step1
Else
Rows(i + j).Insert shift:=xlShiftDown
Range("A" & i + j) = MyDate
Range("B" & i + j) = "振替休日"
j = 1
End If
End If
Next i
'国民の休日チェック
For i = 3 To 25
'Range("A" & i).Select
If Range("A" & i) = Range("A" & i + 1) - 2 Then
MyDate = Range("A" & i) + 1
If Weekday(MyDate) <> 1 Then
Rows(i + 1).Insert shift:=xlShiftDown
Range("A" & i + 1) = MyDate
Range("B" & i + 1) = "国民の休日"
End If
End If
Next i
End Sub |
macro100322aを実行後のシート
今回は祝日を取得しただけですが
これを使ってカレンダーに祝日を組み込んでいきます。
コメント