石鹸箱 IV

VBA研究所に集まる方々の憩いの場です。みなさん自由にお使いください。
ここでは VBA の質問は厳禁。

4920 / 5126 ツリー ←次へ | 前へ→

【1819】谷さんへのお願い。 Jaka 06/1/24(火) 12:36

【1825】Re:へい。のお返事。 Jaka 06/1/27(金) 15:37

【1825】Re:へい。のお返事。
 Jaka  - 06/1/27(金) 15:37 -

引用なし
パスワード
   谷様、こんにちは。
谷様のお手を煩わせた、とんでもない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

4920 / 5126 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
219927
(SS)C-BOARD v3.8 is Free