給与の支払日を計算するVBA

Question

私はAccess Payment Salary DBをプログラミングしており、毎月14日に給与を支払う必要があります。週末、または休日の場合は、13日、12日、11日などでなければなりません（14日前の最後の就業日）。私たちの週末は金曜日と土曜日です - 平日（dteDate、vbSunday）

私の挑戦は、VBAが計算を行うときに正しい値を得られないことです。まず、週末かどうかを確認し、土曜日か日曜日かによって1日か2日を減らし、休暇であるかどうかをテストします（[tblHoliday]。[tblHoliday]）。はいの場合は、それを1日で減らしてください。休日ではありません。それが週末かどうかをテストし、そうであれば正しい日数を減らし、休日かどうか再度テストします。そうでない場合は、日付を返します。私は比較データベース

Private Sub PeriodeEnd_Text_AfterUpdate() 

Dim dtDate As Date 
Dim testDate As Date 

    dtDate = dhLastDayInMonth(Me.PeriodeEnd_Text) + 14 
    testDate = LastWorkDay(dtDate) 

Me.PaymentDay_Text = testDate 

End Sub 

とモジュール

Function dhLastDayInMonth(Optional dtmDate As Date = 0) As Date 
    ' Return the last day in the specified month. 
    If dtmDate = 0 Then 
     ' Did the caller pass in a date? If not, use 
     ' the current date. 
     dtmDate = Date 
    End If 
    dhLastDayInMonth = DateSerial(Year(dtmDate), _ 
    Month(dtmDate) + 1, 0) 
End Function 

    Public Function LastWorkDay(Dt As Date) As Date 

    Dim Searching As Boolean 
    Searching = True 

    Do While Searching 
     If Weekday(LastWorkDay, vbSunday) > 5 Then 
     '-- Weekend day, back up a day 
     LastWorkDay = LastWorkDay - 1 
     Else 
     If Weekday(LastWorkDay, vbSunday) > 5 Or _ 
      Not IsNull(DLookup("[HolidayDate]", "tblHoliday", _ 
           "[HolidayDate] = " & Format(LastWorkDay, "\#mm\/dd\/yyyy\#;;;\N\u\l\l"))) Then 
      '-- The above Format of LastWorkday works with US or UK dates! 
      LastWorkDay = LastWorkDay - 1 
     Else 
      '-- The search is over 
      Searching = False 
     End If 
     End If 
    Loop 
End Function 

Answer 1

でこれを持っているでこれを使用しています

私はクリーンな答えがあると確信しているが、おそらくこれを試してみてください？

種類は

Function WhenIsNextPayDate() As Date 

Dim dteIn7days As Date 
Dim dteTemp As Date 
Dim intDayOfWeek As Integer 
Dim blnNonPayDate As Boolean 

'I have used the actual 2016 easter holiday dates in Oz and 
'pretended that your pay day was actually the 28th (a Monday) 
'We are imagining today is the 21st of March 2016 and 
'that we would like to know the pay date at least a week ahead 

dteIn7days = #3/21/2016# + 7 

If DatePart("d", dteIn7days) = 28 Then 

    'Keep going back in time until pay day is not Saturday, Sunday or a public holiday 
    dteTemp = dteIn7days 
    Do 

     blnNonPayDate = False 

     intDayOfWeek = DatePart("w", dteTemp) 

     Select Case intDayOfWeek 

      Case vbSaturday '7 

       blnNonPayDate = True 
      Case vbSunday '1 

       blnNonPayDate = True 
      Case Else 

       '(I imagine you already have a function to test a date 
       'in the public holiday table) 
       'This is to illustrate the case of 2 public holidays 
       'Easter friday and easter monday 
       If dteTemp = #3/25/2016# Or dteTemp = #3/28/2016# Then 

        blnNonPayDate = True 
       End If 
     End Select 

     If blnNonPayDate = False Then 

      'Pay day - thursday 24th March 2016 
      WhenIsNextPayDate = dteTemp 
      Debug.Print WhenIsNextPayDate 
      Exit Do 
     Else 

      'Keep going back in time 
      dteTemp = dteTemp - 1 
     End If 
    Loop 
End If 

End Function 

Answer 2

（OPに代わって投稿）について。

ここでは動作している最終コードです！

Private Sub PeriodeEnd_Text_AfterUpdate() 

Dim dtDate As Date 
Dim testDate As Date 

    dtDate = dhLastDayInMonth(Me.PeriodeEnd_Text) + 14 
    testDate = WhenIsNextPayDate(dtDate) 

Me.PaymentDay_Text = testDate 

End Sub 

Function dhLastDayInMonth(Optional dtmDate As Date = 0) As Date 
     ' Return the last day in the specified month. 
     If dtmDate = 0 Then 
      ' Did the caller pass in a date? If not, use 
      ' the current date. 
      dtmDate = Date 
     End If 
     dhLastDayInMonth = DateSerial(Year(dtmDate), _ 
     Month(dtmDate) + 1, 0) 
    End Function 

Function WhenIsNextPayDate(Dt As Date) As Date 

Dim dteIn7days As Date 
Dim dteTemp As Date 
Dim intDayOfWeek As Integer 
Dim blnNonPayDate As Boolean 

'I have used the actual 2016 easter holiday dates in Oz and 
'pretended that your pay day was actually the 28th (a Monday) 
'We are imagining today is the 21st of March 2016 and 
'that we would like to know the pay date at least a week ahead 

dteIn7days = Dt 

If DatePart("d", dteIn7days) = 14 Then 

    'Keep going back in time until pay day is not Saturday, Sunday or a public holiday 
    dteTemp = dteIn7days 
    Do 

     blnNonPayDate = False 

     intDayOfWeek = DatePart("w", dteTemp) 

     Select Case intDayOfWeek 

      Case vbFriday '7 

       blnNonPayDate = True 
      Case vbSaturday '1 

       blnNonPayDate = True 
      Case Else 

       '(I imagine you already have a function to test a date 
       'in the public holiday table) 
       'This is to illustrate the case of 2 public holidays 
       'Easter friday and easter monday 
       If Not IsNull(DLookup("[HolidayDate]", "tblHoliday", "[HolidayDate] = " & Format(dteTemp, "\#mm\/dd\/yyyy\#;;;\N\u\l\l"))) Then 

        blnNonPayDate = True 
       End If 
     End Select 

     If blnNonPayDate = False Then 

      'Pay day - thursday 24th March 2016 
      WhenIsNextPayDate = dteTemp 
      Debug.Print WhenIsNextPayDate 
      Exit Do 
     Else 

      'Keep going back in time 
      dteTemp = dteTemp - 1 
     End If 
    Loop 
End If 

End Function