月末、月初、ある時点の年齢をマクロ化する

１．Dateserial関数の利用

月末、月初をVBAでコントロールするなら、個人的には、DateSeral関数一択だと思います。関数の使用方法のポイントについていえば、月末を取得しようとする場合、うるう年が存在するので、翌月の初日から１日を減らすのですが、この時の引数は0を使用するというところでしょうか。簡単にDateSerial関数を説明します。

関数　DateSerial（year,month,day）

引数	説明	数値	必須か
year	年（西暦4桁）	「年」の数値を100 ～ 9999の整数で指定	必須
month	月（1～12）	「月」の数値を整数で指定	必須
day	日	「日」の数値を整数で指定	必須

処理のイメージとしては次の図のようなイメージになります。

それでは、処理のマクロのコードを見てみましょう。

Sub 日付変換()

Dim sDate As Date
sDate = Cells(2, 3).Value '基準日を取得

'当月初日
Cells(4, 3).Value = DateSerial(Year(sDate), Month(sDate), 1)
'当月末日
Cells(5, 3).Value = DateSerial(Year(sDate), Month(sDate) + 1, 0)
'前月初日
Cells(6, 3).Value = DateSerial(Year(sDate), Month(sDate) - 1, 1)
'前月末日
Cells(7, 3).Value = DateSerial(Year(sDate), Month(sDate), 0)
'翌月初日
Cells(8, 3).Value = DateSerial(Year(sDate), Month(sDate) + 1, 1)
'翌月末日
Cells(9, 3).Value = DateSerial(Year(sDate), Month(sDate) + 2, 0)
'3か月後初日
Cells(10, 3).Value = DateSerial(Year(sDate), Month(sDate) + 3, 1)
'3か月後末日
Cells(11, 3).Value = DateSerial(Year(sDate), Month(sDate) + 4, 0)

End Sub

※セルの位置は、任意で指定して下さい

２．生年月日からある時点の年齢を計算する（DatedDiff関数）

年齢によって、価格の違うサービスあり、そのサービスが例えば、１年ごとに更新されるようなものであるとき、契約更新時点での年齢を自動的に算出することが必要とされます。その場合、例えば２～３か月前に更新内容を表示した通知を送るようなことが多いのではないでしょうか。年齢をキーにして、サービス内容が変わるので、多くの企業では毎月、特定の日に年齢データの更新をする必要があります。大会社であれば、そういったデータ更新作業をシステムベンダーに丸投げすることが多いのですが、中小で資本力がないけれど、サブスクのようなビジネスを提供中の企業では、自身でそういった管理をやっていく必要があります。データをExcelのまま管理していたり、一旦Excelで加工したデータを基幹システムにアップでするようなことを行っている企業も多いのではないでしょうか。VBAのDateDiff関数を利用したプログラムはそうした場面で活躍します。

Excelには、DATEDIF関数というとても便利な関数があり、一発である年齢を求めることができるのですが、ExcelVBAでは、残念ながらDATEDIF関数が用意されていません。もちろん、Excelに用意された関数をVBA上で動かす「ワークシート関数」を利用するという手はあるのですが、うるう年のバグがあり、お勧めできません。確実な処理をするならば、DateDiff関数の一択となります。

処理のイメージとしては次のようなものです。

それでは、マクロのコードを見てみましょう。

Sub 年齢計算()

Dim aTerm As Integer  '契約期間
Dim dBirth As Date  '誕生日
Dim sDate As Date   '契約開始日

'最終行の取得
Dim lstRow As Long
lstRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

'繰り返し処理
Dim i As Long

For i = lstRow To 2 Step -1
    
    dBirth = Cells(i, 5).Value
    sDate = Cells(i, 2).Value
    
    '満年齢計算
    Cells(i, 4).Value = ageCal(dBirth, sDate)
    
    '次回の満年齢計算
    aTerm = Cells(i, 1).Value
    Cells(i, 7).Value = ageCal(dBirth, sDate) + aTerm
    
Next

End Sub

Function ageCal(x As Date, y As Date)
    
    Dim age As Integer
    age = DateDiff("yyyy", x, y)
    
    If y < DateSerial(Year(y), Month(x), Day(x)) Then
        age = age - 1
    End If
    
    ageCal = age

End Function