SBMJOB翌営業日算出や数日前に遡及した日付計算は業務でよく使いますよね。システム内に休日テーブルを持っていてかつ適切なメンテナンスがなされていればかなり小回りの効く日付計算が行えます。この投稿では簡単な例を使って営業日の計算と地域限定した日付の計算実装方法をご紹介します。
目次
概要
左の3段ある日付部分は基準日（基本的に本日）を変更すると1営業日前と翌営業日が休日テーブルを参照しながら自動計算される仕組みです。基準日はデートピッカーで選択・変更できます。
左の3段ある日付の下にある特別とは休日テーブルの特別フラグが立っている休日を考慮する時に「特別」と入力します。
これは沖縄や埼玉等地域特有の休日が存在するからです。全国に拠点がある企業ではこの点も考慮する必要があります。
祝日、振替休日、創立記念日、年末年始休暇等を入力しておきます。
なお特別な休日には特別フラグをセットし特別な時だけ考慮することも可能。
基準日の変更イベント起動
基準日はtxtDay1で変更イベントでユーザの入力を検出させます。こうすると、日付形式で入力完了した時点で処理がはしります。
1営業日前をGetPreviousWorkDayで算出させます
翌営業日をGetNextWorkDayで算出させます
Private Sub txtDay1_Change()
If (Me.txtDay1.Text Like "####/##/##" And IsDate(Me.txtDay1.Text)) Or (Me.txtDay1.Text Like "####/#/##" And IsDate(Me.txtDay1.Text)) Or (Me.txtDay1.Text Like "####/#/#" And IsDate(Me.txtDay1.Text)) Then
If Me.txt特別 = "特別" Then
'1日前営業日を算出してtxt1日前営業日にセット
Me.txt1日前営業日 = GetPreviousWorkDay(CDate(txtDay1.Text), True)
'翌営業日を算出してtxtDay2にセット
Me.txtDay2 = GetNextWorkDay(CDate(txtDay1.Text), True)
Else
'1日前営業日を算出してtxt1日前営業日にセット
Me.txt1日前営業日 = GetPreviousWorkDay(CDate(txtDay1.Text), False)
'翌営業日を算出してtxtDay2にセット
Me.txtDay2 = GetNextWorkDay(CDate(txtDay1.Text), False)
End If
End If
End Sub一営業日前算出・翌営業日算出
GetPreviousWorkDay → CheckHoliday の流れで
一営業日前の日にちと一営業日後の日付を呼び出し元に返します。
'引数として受け取った日付の次の営業日を返す関数
Function GetNextWorkDay(dtDate As Date, tokubetuFlag As Boolean) As Date
'次の日に設定しなおす
dtDate = dtDate + 1
'CheckHoliday関数の返り値がFalse(休日ではない)まで1日ずつ加算する。
Do Until CheckHoliday(dtDate, tokubetuFlag) = False
dtDate = dtDate + 1
Loop
GetNextWorkDay = dtDate
End Function
'引数として受け取った日付の次の営業日を返す関数
Function GetPreviousWorkDay(dtDate As Date, tokubetuFlag As Boolean) As Date
'次の日に設定しなおす
dtDate = dtDate - 1
'CheckHoliday関数の返り値がFalse(休日ではない)まで1日ずつ減算する。
Do Until CheckHoliday(dtDate, tokubetuFlag) = False
dtDate = dtDate - 1
Loop
GetPreviousWorkDay = dtDate
End Function
'holiday(祝祭日テーブル)を使用して指定した日付が祝祭日、土日かを判定する関数
'祝祭日、土日の場合はTrueを返す
Function CheckHoliday(dt As Date, tokubetuFlag As Boolean) As Boolean
Dim holidayTableCheck As Boolean
If tokubetuFlag = True Then
holidayTableCheck = IsNull(DLookup("holiday", "holiday", "holiday = #" & Format(dt, "yyyy/mm/dd") & "#")) '沖縄の場合
Else
holidayTableCheck = IsNull(DLookup("holiday", "holiday", "holiday = #" & Format(dt, "yyyy/mm/dd") & "#" & "AND tokubetu = FALSE")) '沖縄にあらず
End If
'Dim flg As Boolean
'holiday(祝祭日テーブル)テーブルを検索し、引数として受け取った日付が祝祭日に
'あたるかどうか確認する
If holidayTableCheck = True Then
'祝祭日に該当しない場合は、土曜日か日曜日かをチェック
'土日が休みでない場合は、Caseに指定する数値を該当の曜日を表す数値に変更する。
Select Case Weekday(dt, vbSunday) '日曜日が1、土曜日が7になる
Case 1
CheckHoliday = True
Case 7
CheckHoliday = True
Case Else
CheckHoliday = False
End Select
Else
'引数に指定した日付がholiday(祝祭日テーブル)テーブルの日付に該当、つまり祝祭日
CheckHoliday = True
End If
End Function特別文字列判定とRequery
特別テキストボックスに特別と入力すると
休日マスターのチェックを入れた休日が考慮されます。
Private Sub txt特別_AfterUpdate()
Me.txtDay1.SetFocus
Call txtDay1_Change
Me.txt特別.SetFocus
Me.Requery
End Sub
コメント