设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 1280|回复: 2
打印 上一主题 下一主题

[模块/函数] 请教这个计算工作日的函数有何不对

[复制链接]
跳转到指定楼层
1#
发表于 2008-3-24 15:13:20 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
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
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
2#
 楼主| 发表于 2008-3-24 15:15:19 | 只看该作者
主要是计算2个日期间的工作时间,节假日去处,周六周日遇到上班日则加上,如果高手有更好的代码请发上来 ,谢谢
3#
 楼主| 发表于 2008-3-24 15:43:36 | 只看该作者
高手赶快回答阿   急[:30]
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-5-12 16:48 , Processed in 0.096955 second(s), 26 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表