満年齢と干支の計算
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。
期間内の満の年月日と干支と日数・月数・曜日を求める　　　　　　　　（０２３）
　　　　　　 当初に書いたもので、あまりにも不細工なので、書き直して見ました。
結構、会社等で従業員の名簿作成等で使う機会も多いかと思います。
ExcelにはDATEDIF関数の引数に "Y" ,"YM" ,"MD" を指定すると簡単に満の年齢や
月・日が取得出来るのですが、VBでは期間の延べ日数や月数しか取得できませんので
DATEDIF関数と同様の関数を作ってみました。
テキストボックス２個とラベル４個とコマンドボタン１個を貼り付けて下さい。

DATEDIF関数はExcel上では下記のように使用しますが、[関数ウィザード] の「関数名
一覧」に含まれていないし、ヘルプでも見当たらないのであまり知られていないようです。
　　　　

=DATEDIF(開始年月日,終了年月日,"Y")

経過した年数

=DATEDIF(開始年月日,終了年月日,"YM")

経過した1年未満の月数

=DATEDIF(開始年月日,終了年月日,"MD")

経過した1月未満の日数


Private Sub Form_Load()
　　'初期値の設定
　　Text1.Text = "2001/12/1"　　'愛子様の誕生日
　　Text2.Text = Date　　　　　 '現在日
End Sub

Private Sub Command1_Click()
　　Label1.Caption = fDateDif_Y(CDate(Text1.Text), _
　　　　　　　　　　　　　　　　CDate(Text2.Text)) & " 年"
　　Label2.Caption = fDateDif_YM(CDate(Text1.Text), _
　　　　　　　　　　　　　　　　 CDate(Text2.Text)) & " ヶ月"
　　Label3.Caption = fDateDif_MD(CDate(Text1.Text), _
　　　　　　　　　　　　　　　　 CDate(Text2.Text)) & " 日"
　　Label4.Caption = fDateDif_YYMMD(CDate(Text1.Text), _
　　　　　　　　　　　　　　　　　　CDate(Text2.Text))
End Sub

'経過した年数を求める関数
Private Function fDateDif_Y(ByVal date1 As Date, _
　　　　　　　　　　　　　　ByVal date2 As Date) As Integer
　　Dim Y As Integer
　　Y = DateDiff("yyyy", date1, date2)
　　'比較月以前だったら
　　If Month(date1) > Month(date2) Then
　　　　'年数を１ヶ月引く
　　　　Y = Y - 1
　　ElseIf Month(date1) = Month(date2) Then
　　　　'同月で比較日以前の場合
　　　　If Day(date1) > Day(date2) Then
　　　　　　'年数を１ヶ月引く
　　　　　　Y = Y - 1
　　　　End If
　　End If
　　fDateDif_Y = Y
End Function

'経過した1年未満の月数を求める関数
Private Function fDateDif_YM(ByVal date1 As Date, _
　　　　　　　　　　　　　　 ByVal date2 As Date) As Integer
　　Dim M As Integer
　　M = DateDiff("m", date1, date2)
　　'比較日以前だったら
　　If Day(date1) > Day(date2) Then
　　　　'月数を１ヶ月引く
　　　　M = M - 1
　　End If
　　M = M Mod 12
　　fDateDif_YM = M
End Function

'経過した1月未満の日数を求める関数
Private Function fDateDif_MD(ByVal date1 As Date, _
　　　　　　　　　　　　　　 ByVal date2 As Date) As Integer
　　Dim D As Integer
　　'比較日以前だったら
　　If Day(date1) > Day(date2) Then
　　　　'前月の末日を求める
　　　　D = Day(DateAdd("d", -1, DateAdd("m", 0, _
　　　　　　　　　　　　DateValue(Format$(date2, "yyyy年mm月")))))
　　　　'末日までの日数を求める
　　　　D = D - Day(date1)
　　　　'当月の日数をプラスする
　　　　D = D + Day(date2)
　　Else
　　　　'日数数を引く
　　　　D = Day(date2) - Day(date1)
　　End If
　　fDateDif_MD = D
End Function


'ついでに一度ですべてを求める関数
Private Function fDateDif_YYMMD(ByVal date1 As Date, _
　　　　　　　　　　　　　　　　ByVal date2 As Date) As String
'年月日を一度に計算する場合
　　Dim Y As Integer
　　Dim M As Integer
　　Dim D As Integer
　　M = DateDiff("m", date1, date2)
　　'比較日以前だったら
　　If Day(date1) > Day(date2) Then
　　　　'月数を１ヶ月引く
　　　　M = M - 1
　　　　'前月の末日を求める
　　　　D = Day(DateAdd("d", -1, DateAdd("m", 0, _
　　　　　　　　　　　　DateValue(Format$(date2, "yyyy年mm月")))))
　　　　'末日までの日数を求める
　　　　D = D - Day(date1)
　　　　'当月の日数をプラスする
　　　　D = D + Day(date2)
　　Else
　　　　D = Day(date2) - Day(date1)
　　End If
　　Y = M \ 12
　　M = M Mod 12
　　fDateDif_YYMMD = Y & "年" & M & "ヶ月" & D & "日"
End Function


干支は下記のような方法で求められます。

干支=Mid$("申酉戌亥子丑寅卯辰巳午未", (Year("2001/12/1") Mod 12) + 1, 1)


その他 曜日 期間内の日数と月数は下記で求められます。

曜日=Format$("2001/12/1", "aaaa")

期間内日数=DateDiff("d", "2001/12/1", "2003/2/12")

期間内月数=DateDiff("m", "2001/12/1", "2003/2/12")




2003/02/12