Attribute VB_Name = "Module1"
'■　マクロ５００連発＜第２段＞
'
'　年齢を計算する
'
'  Copyright(C) 2000 Sunago
'
Option Explicit

Sub Macro1()
Dim strTanjyobi As String
Dim vntNenrei As Variant

    '誕生日を和暦(ge/m/d形式)または西暦で設定する
    strTanjyobi = "H1/2/1"
    vntNenrei = fncNenrei(strTanjyobi, Date)
    MsgBox "誕生日　" & strTanjyobi & vbCr & _
            "年齢　　" & Int(vntNenrei) & "歳" & _
                    vntNenrei * 100 Mod 100 & "ヶ月"
End Sub

'/* 年齢計算関数(fncNenrei) */
'
'　Tanjyobi := 誕生日(ge/m/d形式又はy/m/d)
'  Kijyunbi := 基準日(y/m/d)
'  戻り値 := 文字列(整数部は年齢で小数部は月数）

Function fncNenrei(ByVal Tanjyobi As Variant, ByVal Kijyunbi As Variant) As Variant
Dim nOld As Integer         ''年齢(年)
Dim nTuki As Integer        ''　　(月)

    If IsDate(Tanjyobi) = False Then
        fncNenrei = "#Error"
        Exit Function
    Else
        Tanjyobi = CVDate(Tanjyobi)  'gee/mm/dd => yyyy/mm/dd
    End If
    If IsDate(Kijyunbi) = False Then
        fncNenrei = "#Error"
        Exit Function
    Else
        Kijyunbi = CVDate(Kijyunbi)
    End If
    
    If Kijyunbi < Tanjyobi Then
        fncNenrei = "#Error"
        Exit Function
    End If
    '年齢(？歳？カ月)を計算する
    If Kijyunbi = Tanjyobi Then
        nOld = 0
        nTuki = 0
    ElseIf Year(Kijyunbi) <> Year(Tanjyobi) Then
        'DateDiff関数を用いて数え歳-1を求める
        nOld = DateDiff("yyyy", Tanjyobi, Kijyunbi) - 1
        nTuki = Month(Kijyunbi) - Month(Tanjyobi) + 11
        If Day(Kijyunbi) >= Day(Tanjyobi) Then
            nTuki = nTuki + 1
        End If
        If nTuki >= 12 Then
            nOld = nOld + 1
            nTuki = nTuki - 12
        End If
    Else
        nOld = 0
        If Month(Kijyunbi) = Month(Tanjyobi) Then
            nTuki = 0
        ElseIf Month(Kijyunbi) >= Month(Tanjyobi) Then
            If Day(Kijyunbi) >= Day(Tanjyobi) Then
                nTuki = Month(Kijyunbi) - Month(Tanjyobi)
            Else
                nTuki = Month(Kijyunbi) - Month(Tanjyobi) - 1
            End If
        End If
    End If
    '戻り値のセット
    fncNenrei = Format$(CDec(nOld + nTuki * 0.01), "0.00")

End Function