Option Explicit
Function n_hol(dd As Date) As String
    '祝日ならその日を返すサブルーチン　V0.9 日付型変数を渡すと祝日等を返す
    '注意:年毎に祝日を入力する必要がある。変更のある場合があるため
    'ASP等のVB SCCIPTSで使用するときはAs String, As Integer等の型定義をはずすこと
    '
    'このプログラムは改変可能なフリーウェアです。いかなる条件でも正しく動作することを確認してません
    '各自の責任で使用して下さい
    '
    '古口正巳 [koguchi@sf.airnet.ne.jp] http://www3.airnet.ne.jp/koguchi
    '
    '
    Select Case DateSerial(Year(dd), Month(dd), Day(dd)) '00:00:00にセットしないと演算できない
'毎年のデーターを入れて下さい　年　月　日を必ず指定する
'毎年変わる祝日　春分・秋分の日などに注意
'先に一致する項目があれば後で一致しても出力されない
'1998　前年の必要がなければ消去
        Case DateSerial(1998, 5, 4)
            n_hol = "振替休日"
'1999
        Case DateSerial(1999, 3, 22)
            n_hol = "振替休日"
        Case DateSerial(1999, 5, 4)
            n_hol = "国民の祝日"
        Case DateSerial(1999, 10, 11)
            n_hol = "振替休日"

'毎年変わらないものは　year(dd)を変更しないで月と日だけを記入する
        Case DateSerial(Year(dd), 1, 1)
            n_hol = "元旦"
        Case DateSerial(Year(dd), 1, 15)
            n_hol = "成人の日"
        Case DateSerial(Year(dd), 2, 11)
            n_hol = "建国記念日"
        Case DateSerial(Year(dd), 3, 21)
            n_hol = "春分の日"
        Case DateSerial(Year(dd), 4, 29)
            n_hol = "みどりの日"
        Case DateSerial(Year(dd), 5, 1)   '必要に応じてコメントして下さい
            n_hol = "メーデー"
        Case DateSerial(Year(dd), 5, 3)
            n_hol = "憲法記念日"
        Case DateSerial(Year(dd), 5, 5)
            n_hol = "こどもの日"
        Case DateSerial(Year(dd), 7, 20)
            n_hol = "海の日"
        Case DateSerial(Year(dd), 9, 15)
            n_hol = "敬老の日"
        Case DateSerial(Year(dd), 9, 23)
            n_hol = "秋分の日"
        Case DateSerial(Year(dd), 10, 10)
            n_hol = "体育の日"
        Case DateSerial(Year(dd), 11, 3)
            n_hol = "文化の日"
        Case DateSerial(Year(dd), 11, 23)
            n_hol = "勤労感謝の日"
        Case DateSerial(Year(dd), 12, 23)
            n_hol = "天皇誕生日"
'毎月変わらないものは　year(dd) month(dd)を変更しないで日だけを記入する
        'Case DateSerial(Year(dd), Month(dd), 25)
        '    n_hol = "給料日"
'一致しなかった場合返す文字列を設定して下さい
        Case Else
            n_hol = ""
    End Select
End Function

Function taiin(dd As Date) As String
    '太陽歴から太陰歴の月日を求めるサブルーチン　V0.9 日付型変数を渡すと六曜と旧暦を返す
    '注意:年毎に太陰暦の月と１日の日付を入力する必要がある
    'ASP等のVB SCCIPTSで使用するときはAs String, As Integer等の型定義をはずすこと
    'またFormat文も使用できません
    'このプログラムは改変可能なフリーウェアです。いかなる条件でも正しく動作することを確認してません
    '各自の責任で使用して下さい
    '
    '古口正巳 [koguchi@sf.airnet.ne.jp] http://www3.airnet.ne.jp/koguchi
    '
    'そのまま太陽暦の日付型で返そうと思ったが、太陰暦では2/29があるのでできなかった
    '
    Dim rokuyou(5) As String '六曜表　配列の順番は計算の都合上変えないで下さい
    rokuyou(0) = "大安"
    rokuyou(1) = "赤口"
    rokuyou(2) = "先勝"
    rokuyou(3) = "友引"
    rokuyou(4) = "先負"
    rokuyou(5) = "仏滅"
    Dim hi(15) As Date '太陰歴の1日の日付を指定する
    Dim t_mm As Integer '太陰歴の月
    Dim t_dd As Integer '太陰歴の日
    Dim tuki(15) As Integer '１日の月を指定する
    '↓1998年12月19日は太陰暦の11月1日
    '太陽暦の1/1-12/31までが入るように前年・翌年も含める
    hi(0) = DateSerial(1998, 12, 19): tuki(0) = 11 '1998年のデーター(最後のみ必要)
    hi(1) = DateSerial(1999, 1, 18): tuki(1) = 12 '1999年のデーター(一年分必要)
    hi(2) = DateSerial(1999, 2, 16): tuki(2) = 1
    hi(3) = DateSerial(1999, 3, 18): tuki(3) = 2
    hi(4) = DateSerial(1999, 4, 16): tuki(4) = 3
    hi(5) = DateSerial(1999, 5, 15): tuki(5) = 4
    hi(6) = DateSerial(1999, 6, 14): tuki(6) = 5
    hi(7) = DateSerial(1999, 7, 13): tuki(7) = 6
    hi(8) = DateSerial(1999, 8, 11): tuki(8) = 7
    hi(9) = DateSerial(1999, 9, 10): tuki(9) = 8
    hi(10) = DateSerial(1999, 10, 9): tuki(10) = 9
    hi(11) = DateSerial(1999, 11, 8): tuki(11) = 10
    hi(12) = DateSerial(1999, 12, 8): tuki(12) = 11
    hi(13) = DateSerial(2000, 1, 7): tuki(13) = 12 '2000年のデーター(最初のみ必要)
'↑初期値はパブリック変数にして格納しておいたほうが速度が速いと思われる。
    '1999年でなければ終了　返す文字列を指定して下さい
    If dd < DateSerial(1999, 1, 1) Then taiin = "": Exit Function
    If dd >= DateSerial(2000, 1, 1) Then taiin = "": Exit Function
    
    Dim i As Integer
    dd = DateSerial(Year(dd), Month(dd), Day(dd)) '00:00:00にセットしないと演算できない
    For i = 1 To 13
        If dd < hi(i) Then
            t_dd = dd - hi(i - 1) + 1 '太陰暦の日
            t_mm = tuki(i - 1) '太陰暦の月
            Exit For
        End If
    Next 'Next iだとScriptだとエラーになります
    'ここからは出力したいフォーマットに直して下さい
    taiin = rokuyou((t_mm Mod 6 + t_dd) Mod 6) '六曜表を求める
    taiin = taiin & Format(t_mm, "(00/") & Format(t_dd, "00)")   '太陰暦の月日を返す VB VBA　必要に応じてコメントをはずす
    'taiin = taiin & "(" & Right("00" & t_mm, 2) & "/" & Right("00" & t_dd, 2) & ")" 'VBSCRIPTS ではForamtはだめ
End Function