カテゴリー
Microsoft

【Excel VBA】満年齢を算出する関数コード

学年を求めるためには、4月1日時点で何歳か?、を算出する必要がごさいます。

例えば、次のようになります。

  • 2015/4/1 に 0 歳とカウントされる生まれ: 2014/4/2-
  • 2015/4/1 に 1 歳とカウントされる生まれ: 2013/4/2-2014/4/1
  • 2015/4/1 に 2 歳とカウントされる生まれ: 2012/4/2-2013/4/1
  • 2015/4/1 に 3 歳とカウントされる生まれ: 2011/4/2-2012/4/1
  • 2015/4/1 に 4 歳とカウントされる生まれ: 2010/4/2-2011/4/1
  • 2015/4/1 に 5 歳とカウントされる生まれ: 2009/4/2-2010/4/1

これを、基準日と誕生日を渡してやれば算出してくれる VBA を書きました♪

VBA コード

  • DateDiff 関数の年 (“yyyy”) は、12月31日とその次の年の1月1日の比較結果が 0 ではなく 1 となる。
  • 1月1日とその年の1月2日の比較結果は 0 となる。
  • したがって、年を越しても誕生日を迎えていない場合は -1 歳の計算を行う。
Option Explict

''' <summary>
''' 満年齢を返却します。
''' 基準年月日と比較して算出します。
''' </summary>
''' <param name="dtmBirthday">生年月日</param>
''' <param name="dtmBaseDay">基準年月日</param>
''' <returns>満年齢の数字</returns>
Private Function CaluculateAge( _
    ByVal dtmBirthday As Date, _
    ByVal dtmBaseDay As Date) As Long

    Dim lngAge As Long: lngAge = DateDiff("yyyy", dtmBirthday, dtmBaseDay)
    Dim dtmForCompareMmdd As Date: dtmForCompareMmdd = _
        DateSerial(Year(dtmBaseDay), Month(dtmBirthday), Day(dtmBirthday))
    ' 年を越しても誕生日を迎えていない場合は -1 歳
    If dtmBaseDay < dtmForCompareMmdd Then
        lngAge = lngAge - 1
    End If

    CaluculateAge = lngAge
End Function

Sub Test()
    ' 12 月 31 日と翌年の 1 月 1 日を比較すると、DateDiff は DateInterval.Year、DateInterval.Quarter、DateInterval.Month に対して 1 を返します。
    Debug.Print "2014/12/31 と 2015/1/1 の DateDiff 関数の年 ("yyyy") は、1 であることを確認: " & DateDiff("yyyy", #12/31/2014#, #1/1/2015#)

    Debug.Print
    Debug.Print "2015/4/1 を基準日とする。"
    Debug.Print "2015/4/1 生まれの満年齢: " CaluculateAge(#4/1/2015#, #4/1/2015#]
    Debug.Print "2014/4/2 生まれの満年齢: " CaluculateAge(#4/2/2014#, #4/1/2015#]

    Debug.Print "2014/4/1 生まれの満年齢: " CaluculateAge(#4/1/2014#, #4/1/2015#]
    Debug.Print "2013/4/2 生まれの満年齢: " CaluculateAge(#4/2/2013#, #4/1/2015#]

    Debug.Print "2013/4/1 生まれの満年齢: " CaluculateAge(#4/1/2013#, #4/1/2015#]
    Debug.Print "2012/4/2 生まれの満年齢: " CaluculateAge(#4/2/2012#, #4/1/2015#]
End Sub

これだとダメでした＞＜

上記 2 つを組み合わせてみましたけれども、エラーとなって使えませんでした＞＜。

おわりに

参考ページです。Access の VBA のページを主に参考にいたしましたけれども、問題なく動きました♪

以上です。

コメントを残す