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

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
    '年数を1ヶ月引く
    Y = Y - 1
  ElseIf Month(date1) = Month(date2) Then
    '同月で比較日以前の場合
    If Day(date1) > Day(date2) Then
      '年数を1ヶ月引く
      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
    '月数を1ヶ月引く
    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
    '月数を1ヶ月引く
    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