Question

我正在编写Access Payment Salary DB，工资应该每月支付14日。如果是周末或假日，那么应该是13日，12日，11日等（14日之前的最后一个工作日）。我们的周末是周五和周六 - 工作日（dteDate，vbSunday）

我的挑战是，当VBA进行计算时，我没有得到正确的值。首先它检查它是否是周末，然后减少一到两天（取决于它是星期六或星期日），然后它应该测试它是否是假日（[tblHoliday]。[tblHoliday]）。如果是的话，那么减少它一天 - 直到它不再是假期。然后它将测试它是否是一个周末，如果是，则减少正确的天数，然后测试它是否是一个假期。如果没有，则返回日期。

我在比较数据库中使用它

  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

VBA计算工资的支付日（Access DB）

2 个答案: