|
谷様、こんにちは。
谷様のお手を煩わせた、とんでもないJakaです。
昨日は、調子崩して休んでました。
>>へい。と言えば、「ドレミ天国」の学園天国を思い出す。
>>最近、「ガーフィールド」で「ダンシング・シスター」をようやく聞けました。
>>(ローカルネタ)
>
>うう、わからないっす・・・
セブン以外は打ってないんっすね!
>【59】[管理者削除]
> この書き込みは管理者によって削除されました。(06/1/25(水) 18:41)
なんか荒らしの常習犯みたいですね。
常習犯ですけど....。v(^_^;)v
ちなみにこんな物も書いてみました。
9月の国民の休日は、秋分の日が水曜のときに発生するといった単純な発想でしか捕らえてません。
また確定されている期日を使おうと思いましたが、ponponさんの方法を使用しました。
祝日を月/日の文字列で配列に入れて戻すだけです。
Private Function HolidayTBL(Nen As Long) As Variant
Dim FixHoliday As Variant, SachYear As Long, WekDy As Long
Dim Anp As Variant, CagJan As Long, CagJul As Long, CagSep As Long
Dim Equx39 As Long
'SachYear = 2006
SachYear = Nen
FixHoliday = Array("1/1", "2/11", "4/29", "5/3", "5/4", "5/5", _
"11/3", "11/23", "12/23")
WekDy = WeekDay(SachYear & "/1/1", vbSunday)
If WekDy <= 2 Then
CagJan = 2 - WekDy + ((2 - 1) * 7) + 1
Else
CagJan = 8 - WekDy + ((2 - 1) * 7) + 2
End If
ReDim Preserve FixHoliday(UBound(FixHoliday) + 1)
FixHoliday(UBound(FixHoliday)) = "1/" & CagJan
WekDy = WeekDay(SachYear & "/7/1", vbSunday)
If WekDy <= 2 Then
CagJul = 2 - WekDy + ((3 - 1) * 7) + 1
Else
CagJul = 8 - WekDy + ((3 - 1) * 7) + 2
End If
ReDim Preserve FixHoliday(UBound(FixHoliday) + 1)
FixHoliday(UBound(FixHoliday)) = "7/" & CagJul
WekDy = WeekDay(SachYear & "/9/1", vbSunday)
If WekDy <= 2 Then
CagSep = 2 - WekDy + ((3 - 1) * 7) + 1
Else
CagSep = 8 - WekDy + ((3 - 1) * 7) + 2
End If
ReDim Preserve FixHoliday(UBound(FixHoliday) + 1)
FixHoliday(UBound(FixHoliday)) = "9/" & CagSep
WekDy = WeekDay(SachYear & "/10/1", vbSunday)
If WekDy <= 2 Then
CagOct = 2 - WekDy + ((2 - 1) * 7) + 1
Else
CagOct = 8 - WekDy + ((2 - 1) * 7) + 2
End If
ReDim Preserve FixHoliday(UBound(FixHoliday) + 1)
FixHoliday(UBound(FixHoliday)) = "10/" & CagOct
ReDim Preserve FixHoliday(UBound(FixHoliday) + 1)
'これ以外は、21日(国立天文台より)
'春分20 = Array(2000, 2001, 2004, 2005, 2008, 2009, 2012, 2013, 2016, 2017, _
2020, 2021, 2024, 2025, 2026, 2028, 2029, 2030)
'Anp = Application.Match(SachYear, 春分20, 0)
'If IsError(Anp) Then
' FixHoliday(UBound(FixHoliday)) = "3/" & 21
'Else
' FixHoliday(UBound(FixHoliday)) = "3/" & 20
'End If
Equx39 = Fix(20.8431 + 0.242194 * _
(SachYear - 1980) - Fix((SachYear - 1980) / 4))
FixHoliday(UBound(FixHoliday)) = "3/" & Equx39
ReDim Preserve FixHoliday(UBound(FixHoliday) + 1)
'これ以外は、23日
'秋分22 = Array(2012, 2016, 2020, 2024, 2028)
'Anp = Application.Match(SachYear, 秋分22, 0)
'If IsError(Anp) Then
' FixHoliday(UBound(FixHoliday)) = "9/" & 23
'Else
' FixHoliday(UBound(FixHoliday)) = "9/" & 22
'End If
'秋分の日=DATE($B$1,9,DAY(INT(23.2488+0.242194*($B$1-1980)-INT(($B$1-1980)/4))))
Equx39 = Fix(23.2488 + 0.242194 * _
(SachYear - 1980) - Fix((SachYear - 1980) / 4))
FixHoliday(UBound(FixHoliday)) = "9/" & Equx39
'9月の国民の祝日は、単純に秋分の日が水曜なら火曜としただけ。
If WeekDay(DateValue(SachYear & "/9/" & Equx39), vbSunday) = 4 Then
ReDim Preserve FixHoliday(UBound(FixHoliday) + 1)
FixHoliday(UBound(FixHoliday)) = "9/" & Equx39 - 1
End If
HolidayTBL = FixHoliday
Erase FixHoliday
'Erase 春分20, 秋分22
End Function
Sub カレンダー()
Dim HoriTB As Variant, SchYear As Long
HoriTB = HolidayTBL(Range("J1").Value)
Columns("K").ClearContents
Range("K1").Resize(UBound(HoriTB) + 1).NumberFormatLocal = "@"
Range("K1").Resize(UBound(HoriTB) + 1).Value = Application.Transpose(HoriTB)
Erase HoriTB
End Sub
|
|