|
本帖最后由 yygpdkkk 于 2013-4-13 11:05 编辑
因3楼判断是否工作日的代码在速度上大大逊色于joforn的写法,故对3楼代码作相应修改,也改为Select结构,直接列示节假日。此外,直接列示的节假日采用日期文字亦可增加语言上的可移植性。
- Function MyTime(theStartDate As Variant, theEndDate As Variant) As Variant
- Dim theDate1 As Date, theDate2 As Date, theTime1 As Date, theTime2 As Date, i&, n&
- MyTime = 0 '确保一次赋值
- If Not IsDate(theStartDate) Or Not IsDate(theEndDate) Then '若非法日期,则
- MyTime = CVErr(xlErrNA) '返回错误值
- Exit Function
- End If
- If theEndDate - theStartDate < 0 Then
- MyTime = CVErr(xlErrNA) '若发起时间大于结束时间,则返回错误值
- Exit Function
- End If
- theDate1 = DateSerial(Year(theStartDate), Month(theStartDate), Day(theStartDate))
- theTime1 = theStartDate - theDate1
- theDate2 = DateSerial(Year(theEndDate), Month(theEndDate), Day(theEndDate))
- theTime2 = theEndDate - theDate2
- Select Case theTime1 '确定发起时间(仅指时间部分,不含日期)
- Case Is < TimeValue("9:00:01") '若发起时间早于上午9点,则确定为9点起始
- theTime1 = TimeValue("9:00:00")
- Case Is < TimeValue("12:00:01") '若发起时间早于正午,则theTime1就是发起时间,不用调整
- Case Is < TimeValue("14:00:01") '若发起时间早于下午14点,则确定为12点起始(此处很重要)
- theTime1 = TimeValue("12:00:00")
- Case Is < TimeValue("18:00:01") '若发起时间早于下午18点,则theTime1就是发起时间,不用调整
- Case Else '否则确定为18:00:00
- theTime1 = TimeValue("18:00:00")
- End Select
- Select Case theTime2 '确定结束时间(仅指时间部分,不含日期)
- Case Is < TimeValue("9:00:01") '若结束时间早于上午9点,则确定为上午9:00:00
- theTime2 = TimeValue("9:00:00")
- Case Is < TimeValue("12:00:01") '若结束时间早于正午,则theTime2就是结束时间,不用调整
- Case Is < TimeValue("14:00:01") '若结束时间早于下午14点零1分,则确定为中午12点结束(此处很重要)
- theTime2 = TimeValue("12:00:00") '(承上述)此处故意把结束时间往早前推(不设为14:00:00),
- '从而与theTime1的12:00:00这一时间点重叠,巧妙地使后续代码的时间相减融为一体,从而不用再专门写代码进行修正
- Case Is < TimeValue("18:00:01") '若结束时间早于下午18点,则theTime2就是结束时间,不用调整
- Case Else '否则确定为18:00:00
- theTime2 = TimeValue("18:00:00")
- End Select
- If theDate1 = theDate2 Then '若发起日期与结束日期为同一天,则
- If MyWorkDay(theDate1) Then '若为工作日,则
- If theTime1 < TimeValue("12:00:01") Then
- If theTime2 < TimeValue("14:00:01") Then
- MyTime = theTime2 - theTime1 '两个时间均处于上午,则直接相减
- Else
- MyTime = TimeValue("12:00:00") - theTime1 '先计算出上午时长
- MyTime = MyTime + theTime2 - TimeValue("14:00:00") '再加上下午时长
- End If
- Else '否则,两个时间均处于下午
- MyTime = theTime2 - theTime1 '仅下午时长
- End If
- End If
- Else '否则,发起日期与结束日期不为同一天
- If MyWorkDay(theDate1) Then '先计算发起日的时长
- If theTime1 < TimeValue("12:00:01") Then
- MyTime = TimeValue("12:00:00") - theTime1 '先计算出上午时长
- MyTime = MyTime + TimeValue("4:00:00") '再加上下午时长
- Else '否则,计算发起日的下午时长
- MyTime = TimeValue("18:00:00") - theTime1 '仅存在下午时长
- End If
- End If
- If MyWorkDay(theDate2) Then '再计算结束日的时长
- If theTime2 < TimeValue("12:00:01") Then '计算结束日的上午时长
- MyTime = MyTime + theTime2 - TimeValue("9:00:00") '仅存在上午时长
- Else '否则计算结束日的时长
- MyTime = MyTime + TimeValue("3:00:00") + theTime2 - TimeValue("14:00:00") '上午3小时和下午时长
- End If
- End If
- End If
- For i = theDate1 + 1 To theDate2 - 1 '统计介于发起日和结束日之间的非工作日天数
- If Not MyWorkDay(CDate(i)) Then
- n = n + 1
- End If
- Next i
- If theDate2 > theDate1 Then MyTime = MyTime + TimeValue("7:00:00") * (theDate2 - theDate1 - 1 - n) '介于发起日和结束日之间的其他天数必定为7小时
- End Function
- Private Function MyWorkDay(theDate As Date) As Boolean
- '本函数当前内置数据仅适用于公元2013年
- Select Case theDate
- Case #1/1/2013# To #1/3/2013#: Exit Function '元旦
- Case #2/9/2013# To #2/15/2013#: Exit Function '春节
- Case #4/4/2013# To #4/6/2013#: Exit Function '清明节
- Case #4/29/2013# To #5/1/2013#: Exit Function '劳动节
- Case #6/10/2013# To #6/12/2013#: Exit Function '端午节
- Case #9/19/2013# To #9/21/2013#: Exit Function '中秋节
- Case #10/1/2013# To #10/7/2013#: Exit Function '国庆节
- Case #1/5/2013# To #1/6/2013#, #2/16/2013# To #2/17/2013#, #4/7/2013#, #4/27/2013# To #4/28/2013# _
- , #6/8/2013# To #6/9/2013#, #9/22/2013#, #9/29/2013#, #10/12/2013# '调休日
- MyWorkDay = True: Exit Function
- Case Else
- If Weekday(theDate, vbMonday) < 6 Then MyWorkDay = True
- End Select
- End Function
复制代码
|
|