起算日から6月経過しているか調べる【リクエスト編】

スポンサーリンク

2019年7月7日、「起算日から経過月数を調べる関数を作りました」の記事に、「ちんくさん」からコメントをいただきました。

「日付Aと日付Bを指定し、その間の期間が6月以下の期間であれば「×」、6月を超える期間であれば「〇」と判定したい」とのことです。

付帯する条件として、次の2点があります。

  1. 民法の規定に沿って月数を数える
  2. 初日から数える(初日を起算日とする)
スポンサーリンク

やりたいことをまとめます

もう一度、民法の規定を確認します。

民法 第一編 総則 第六章 期間の計算より引用

第138条  期間の計算方法は、法令若しくは裁判上の命令に特別の定めがある場合又は法律行為に別段の定めがある場合を除き、この章の規定に従う。

(期間の起算)

第139条  時間によって期間を定めたときは、その期間は、即時から起算する。

第140条  日、週、月又は年によって期間を定めたときは、期間の初日は、算入しない。ただし、その期間が午前零時から始まるときは、この限りでない。

(期間の満了)

第141条  前条の場合には、期間は、その末日の終了をもって満了する。

第142条  期間の末日が日曜日、国民の祝日に関する法律 (昭和二十三年法律第百七十八号)に規定する休日その他の休日に当たるときは、その日に取引をしない慣習がある場合に限り、期間は、その翌日に満了する。

(暦による期間の計算)

第143条  週、月又は年によって期間を定めたときは、その期間は、暦に従って計算する。

2  週、月又は年の初めから期間を起算しないときは、その期間は、最後の週、月又は年においてその起算日に応当する日の前日に満了する。ただし、月又は年によって期間を定めた場合において、最後の月に応当する日がないときは、その月の末日に満了する。

e-Gov 法令データ提供システム https://elaws.e-gov.go.jp/ より引用しました

民法の規定に沿って1月後に当たる日を調べます。今回の例では、初日を算入しますので、2019/4/5が起算日となり、1月後は2019/5/5が応当日、期間が満了する日は2019/5/4となります。

同様に6月後を調べます。

2月後は2019/6/5、

3月後は2019/7/5、と続けていって

6月後は2019/10/5が応当日、期間が満了する日は2019/10/4となります。

  • 2019/4/5~2019/10/3 → × 6月未満の期間
  • 2019/4/5~2019/10/4 → × ちょうど6月
  • 2019/4/5~2019/10/5 → 〇 6月超の期間
  • 2019/4/5~2019/10/6 → 〇 6月超の期間
スポンサーリンク

VBAのコードを考える

処理の流れを箇条書きにまとめました。

  1. 日付A(起算日)、日付B(基準日)、判定する月数(今回の例では6月)を指定する
  2. 起算日からn月後の満了日を民法第143条第2項に沿って計算する
  3. 基準日がn月後の満了日より大きければ「〇」、そうでなければ「×」を返す

この手順で求めることができそうですね。

では、VBAのコードを組み立てます。関数の名前は「hantei」とします。計算に必要な数値(引数)は起算日、基準日、月数の3つです。

使用される際は、そちらの環境で十分テストのうえ使用してください。

Option Compare Database
Option Explicit

Function hantei(KISAN_YMD As Date, KIZYUN_YMD As Date, tukisu As Long) As Boolean

'手順1 日付A(起算日)、日付B(基準日)、判定する月数(今回の例では6月)を指定する

    '関数hanteiの引数について
    'KISAN_YMD  =起算日  起算する日付を指定する
    'KIZYUN_YMD =基準日  判定したい日付を指定する
    'tukisu     =月数    何月後か指定する
    
    '結果は「〇」か「×」なので、Boolean型(Yes/No型)で表示する
    
'手順2 起算日からn月後の満了日を民法第143条第2項に沿って計算する

    '起算日の日付とn月後の月に属する最後の日付とを比較し、
    '起算日の日付<=n月後の月に属する最後の日付であれば 起算日からn月後の応当日の前日を満了日とし、
    '起算日の日付>n月後の月に属する最後の日付を満了日とする
    
    'n月後の月に属する最後の日付を取得 (n月後の月は何日まであるか調べる)
    
    Dim NISSU As Long  '日数を格納する
    Dim MANRYO_YMD As Date  '満了日を格納する
    
    NISSU = Day(DateSerial(Year(KISAN_YMD), Month(KISAN_YMD) + tukisu + 1, 1) - 1)
    
    '起算日の日付とn月後の月に属する最後の日付とを比較
    If Day(KISAN_YMD) <= NISSU Then
    
        '起算日からn月後の応当日の前日を満了日とする(応当日がその月に存在するとき)
        MANRYO_YMD = DateSerial(Year(KISAN_YMD), Month(KISAN_YMD) + tukisu, Day(KISAN_YMD)) - 1
    Else
    
        'n月後の月に属する最後の日付を満了日とする(応当日がその月に存在しないとき)
        MANRYO_YMD = DateSerial(Year(KISAN_YMD), Month(KISAN_YMD) + tukisu, NISSU)
    End If

'手順3 基準日と満了日を比較し、基準日>満了日 であればTRUE、そうでないときはFalseを返す

    If KIZYUN_YMD > MANRYO_YMD Then
    
        hantei = True
    Else
    
        hantei = False
    End If

End Function
スポンサーリンク

関数のテスト

では関数のテストを行います。次の通りテーブルを作成しました。テーブル名は「テーブル1」とします。

フィールド名データ型
起算日日付/時刻型
基準日日付/時刻型

「テーブル1」 に次の通り日付を入力しました。

起算日基準日
2019/04/052019/10/03
2019/04/052019/10/04
2019/04/052019/10/05
2019/04/052019/10/06
2019/08/302020/02/29
2019/08/312020/02/28
2019/08/312020/02/29
2019/08/312020/03/01

次にクエリを作成します。クエリを新規作成し、SQLビューに切り替え、以下のSQL文を貼り付けてください。

SELECT [テーブル1].起算日, [テーブル1].基準日, hantei([テーブル1]![起算日],[テーブル1]![基準日],6) AS 式1
FROM テーブル1
ORDER BY [テーブル1].起算日, [テーブル1].基準日;
SQLビューに切り替えてSQL文を貼り付けたところ
SQLビューに切り替えてSQL文を貼り付けたところ

起算日と基準日はテーブル1から貼り付け、式1には今回作成した関数「hantei」を入力します。

式ビルダーで関数hanteiに引数を指定します
式ビルダーで関数hanteiに引数を指定します
式ビルダーで関数hanteiに引数を指定します
式ビルダーで関数hanteiに引数を指定します

起算日と基準日の期間が6月を超えているか判定したいので、次の通り引数を指定します。

引数 KISAN_YMD に [テーブル1]![起算日]を指定。

引数 KIZYUN_YMD に[テーブル1]![基準日]を指定。

引数 tukisu に 6 を指定ました。

クエリ1 の実行結果は次の通りです。なお、Accessでは、TRUEが「-1」、Falseが「0」となります。

起算日基準日式1
2019/04/052019/10/030
2019/04/052019/10/040
2019/04/052019/10/05-1
2019/04/052019/10/06-1
2019/08/302020/02/290
2019/08/312020/02/280
2019/08/312020/02/290
2019/08/312020/03/01-1

想定した通りの結果が表示されました。

ちんくさん、いかがでしょうか。

解説編を作成しましたので、こちらもご覧ください。

コメントをどうぞ!

  1. ちんく より:

    できました!
    見ず知らずの者の勝手な要望に迅速に答えていただき感謝の言葉もありません。
    本当にありがとうございました。私も自分でVBAをできるようにしていきたいと思います。
    取り急ぎ、本当にありがとうございました!!

    • 和休 和休 より:

      このぐらいならお安い御用です!

      私はVBAを極めているわけではありませんので、解決できないことも多くありますが、また悩まれたときは、お気軽にご相談ください。

タイトルとURLをコピーしました