Office中国论坛/Access中国论坛

标题: 请教这个计算工作日的函数有何不对 [打印本页]

作者: sarfeilee 时间: 2008-3-24 15:13
标题: 请教这个计算工作日的函数有何不对
Public Function NetWorkDays(StartDate As Date, EndDate As Date) As Integer

Dim dbs As Database
Dim rstHolidays As Recordset
Dim rstAddiWorkingDay As Recordset

Dim Idx As Long
Dim MyDate As Date
Dim NumDays As Long
Dim strCriteria As String
Dim NumSgn As String * 1

Set dbs = CurrentDb
Set rstHolidays = dbs.OpenRecordset("Holidays", dbOpenDynaset)
Set rstAddiWorkingDay = dbs.OpenRecordset("AdditionalWorkingDay", dbOpenDynaset)

NumSgn = Chr(35)

If EndDate >= StartDate Then

      MyDate = Format(StartDate, "Short Date")

      For Idx = CLng(StartDate) To CLng(EndDate)

         Select Case (Weekday(MyDate))
            Case Is = 1    'Sunday
                  strCriteria = "[AdditionalWorkingDay] = " & NumSgn & Format$(MyDate, "yyyy-mm-dd") & NumSgn
                  rstAddiWorkingDay.FindFirst strCriteria

                  If (rstHolidays.NoMatch) Then

                  Else
                  NumDays = NumDays + 1
                  End If

            Case Is = 7    'Saturday
                  strCriteria = "[AdditionalWorkingDay] = " & NumSgn & Format$(MyDate, "yyyy-mm-dd") & NumSgn
                  rstAddiWorkingDay.FindFirst strCriteria

                  If (rstAddiWorkingDay.NoMatch) Then

                  Else
                  NumDays = NumDays + 1
                  End If
            Case Else    'Normal Workday

                  strCriteria = "[HolidayDate] = " & NumSgn & Format$(MyDate, "yyyy-mm-dd") & NumSgn

                  rstHolidays.FindFirst strCriteria

                  If (rstAddiWorkingDay.NoMatch) Then

                     NumDays = NumDays + 1

                  Else

                  End If

         End Select

         MyDate = DateAdd("d", 1, MyDate)

      Next Idx

      NetWorkDays = NumDays - 1

ElseIf EndDate < StartDate Then

      MyDate = Format(EndDate, "Short Date")

      For Idx = CLng(EndDate) To CLng(StartDate)

         Select Case (Weekday(MyDate))

            Case Is = 1    'Sunday
            strCriteria = "[AdditionalWorkingDay] = " & NumSgn & Format$(MyDate, "yyyy-mm-dd") & NumSgn
                  rstAddiWorkingDay.FindFirst strCriteria

                  If (rstAddiWorkingDay.NoMatch) Then

                  Else
                  NumDays = NumDays + 1
                  End If
            Case Is = 7    'Saturday
                  strCriteria = "[AdditionalWorkingDay] = " & NumSgn & Format$(MyDate, "yyyy-mm-dd") & NumSgn
                  rstAddiWorkingDay.FindFirst strCriteria

                  If (rstAddiWorkingDay.NoMatch) Then

                  Else
                  NumDays = NumDays + 1
                  End If
            Case Else    'Normal Workday

                  strCriteria = "[HolidayDate] = " & NumSgn & Format$(MyDate, "yyyy-mm-dd") & NumSgn

                  rstHolidays.FindFirst strCriteria

                  If (rstHolidays.NoMatch) Then

                     NumDays = NumDays + 1

                  Else

                  End If

         End Select

         MyDate = DateAdd("d", 1, MyDate)

      Next Idx

      NetWorkDays = -NumDays + 1

End If
rstHolidays.Close
rstAddiWorkingDay.Close
End Function

作者: sarfeilee 时间: 2008-3-24 15:15
主要是计算2个日期间的工作时间，节假日去处，周六周日遇到上班日则加上，如果高手有更好的代码请发上来，谢谢

作者: sarfeilee 时间: 2008-3-24 15:43
高手赶快回答阿急[:30]

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)