EXCEL 时间函数难题 就高人指点

娃泰贤

yygpdkkk 发表于 2013-4-11 02:09
为此题花了7、8个小时，晕死。
另：代码未经严格测试（短时间内考虑不到那么多细节数据）
代码更新：经再 ...

Sub lqxs()
Function MyTime(theStartDate As Variant, theEndDate As Variant) As Variant
Dim theDate1 As Date, theDate2 As Date, theTime1 As Date, theTime2 As Date, i&
MyTime = 0 '确保一次赋值
If Not IsDate(theStartDate) Or Not IsDate(theEndDate) Then '若非法日期，则
Print MyTime = CVErr(xlErrNA) '返回错误值
        Exit Function
    End If
    If theEndDate - theStartDate < 0 Then
        MyTime = CVErr(xlErrNA) '若发起时间大于结束时间，则返回错误值
        Exit Function
    End If
    If Weekday(theStartDate, vbMonday) > 5 Then '若发起时间为周六或周日，则进一步判断结束时间
        If Weekday(theEndDate, vbMonday) > 5 Then '若结束时间也为周六或周日，则进一步判断是否跨越了一周
            If theEndDate - theStartDate < 6 Then MyTime = 0 '若非跨一周，则返回0值
        End If
    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 Weekday(theDate1, vbMonday) < 6 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 Weekday(theDate1, vbMonday) < 6 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 Weekday(theDate2, vbMonday) < 6 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 '介于发起日和结束日之间的其他天数必定为7小时
        If Weekday(i, vbMonday) < 6 Then
            MyTime = MyTime + TimeValue("7:00:00")
        End If
    Next i
End Function
End Sub

我点运行 提示 缺少 End Sub，但我实在 有在代码的后面 有加 ，所以不知道错在哪，嘿嘿

娃泰贤

yygpdkkk 发表于 2013-4-11 02:09
为此题花了7、8个小时，晕死。
另：代码未经严格测试（短时间内考虑不到那么多细节数据）
代码更新：经再 ...

Sub lqxs()
Function MyTime(theStartDate As Variant, theEndDate As Variant) As Variant
Dim theDate1 As Date, theDate2 As Date, theTime1 As Date, theTime2 As Date, i&
MyTime = 0 '确保一次赋值
If Not IsDate(theStartDate) Or Not IsDate(theEndDate) Then '若非法日期，则
Print MyTime = CVErr(xlErrNA) '返回错误值
        Exit Function
    End If
    If theEndDate - theStartDate < 0 Then
        MyTime = CVErr(xlErrNA) '若发起时间大于结束时间，则返回错误值
        Exit Function
    End If
    If Weekday(theStartDate, vbMonday) > 5 Then '若发起时间为周六或周日，则进一步判断结束时间
        If Weekday(theEndDate, vbMonday) > 5 Then '若结束时间也为周六或周日，则进一步判断是否跨越了一周
            If theEndDate - theStartDate < 6 Then MyTime = 0 '若非跨一周，则返回0值
        End If
    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 Weekday(theDate1, vbMonday) < 6 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 Weekday(theDate1, vbMonday) < 6 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 Weekday(theDate2, vbMonday) < 6 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 '介于发起日和结束日之间的其他天数必定为7小时
        If Weekday(i, vbMonday) < 6 Then
            MyTime = MyTime + TimeValue("7:00:00")
        End If
    Next i
End Function
End Sub

我点运行 提示 缺少 End Sub，但我实在 有在代码的后面 有加 ，所以不知道错在哪，嘿嘿

yygpdkkk

娃泰贤 发表于 2013-4-11 22:36
Sub lqxs()
Function MyTime(theStartDate As Variant, theEndDate As Variant) As Variant
Dim theDat ...

你VBA基础太欠缺，连函数和过程的区别都不知道！！！！

上课啦，扫肓啦：函数是以Function开头，以End Function结束，就如过程以Sub开头，以End Sub结束一样！

言归正传：
1.我写的是一个函数（俗称自定义函数，自己写的嘛，故谓之“自定义”）
2.我写的函数名称是“MyTime”，当然了，在工作表单元格中输入函数时不必太在意函数名称的大小写
3.既然是函数，直接参照平时输函数的习惯输入就行了，比如在C2单元格输入以等号开头的公式“=mytime(A2,B2)”
4.你无端地在一个自定义函数的代码上再套上Sub和End Sub，也不怕他人笑掉大牙

最后：给个在工作表界面下使用该函数的图例

joforn

娃泰贤 发表于 2013-4-11 22:24
谢谢 高手的支持  因为才开始学习VBA  但代码复制进去 有问题
  你看 可不可以 发个文档呢! 再次谢谢

原以为你已经搞定了，所以上午就没有再回复了，下面的代码是处理了星期六及星期日的自定义函数，如果要处理法定节日，你还需要自行修改getLegalHoliday这个函数的处理过程，在此函数中已经有方法介绍了，你可以根据说明自已修改一下。

1. 
   
2. Function WordDateDiff(ByVal Date1 As Date, ByVal Date2 As Date, Optional ByVal OutMode As Long = 0) As String
   
3.   Dim lngTime   As Long, lngDay As Long, DateTemp As Date
   
4.   
   
5.   Select Case Hour(Date1)                     '重新调整起始日期中的时间
   
6.     Case Is < 9:  Date1 = Format$(Date1, "YYYY-MM-DD") & " 09:00:00"
   
7.     Case 12, 13:  Date1 = Format$(Date1, "YYYY-MM-DD") & " 14:00:00"
   
8.     Case Is > 18: Date1 = Format$((Date1 + 1), "YYYY-MM-DD") & " 09:00:00"
   
9.   End Select
   
10.   
    
11.   Select Case Hour(Date2)                     '重新调整终止日期中的时间
    
12.     Case Is < 9:  Date2 = Format$((Date2 - 1), "YYYY-MM-DD") & " 18:00:00"
    
13.     Case 12, 13:  Date2 = Format$(Date2, "YYYY-MM-DD") & " 12:00:00"
    
14.     Case Is > 18: Date2 = Format$(Date2, "YYYY-MM-DD") & " 18:00:00"
    
15.   End Select
    
16.   If Date2 < Date1 Then                       '比较调整后的日期是否合法
    
17.     WordDateDiff = "Error:错误的日期输入！"   '终止日期小于起始日期，返回错误提示
    
18.   Else
    
19.     lngDay = DateDiff("d", Date1, Date2) - getLegalHoliday(Date1, Date2) '计算相差的天数
    
20.    
    
21.     '计算出两个工作时间的相差值
    
22.     Date1 = CDate(Format$(Date2, "YYYY-MM-DD") & " " & Format$(Date1, "HH:NN:SS"))
    
23.     If Date1 > Date2 Then
    
24.       lngDay = lngDay - 1
    
25.      
    
26.       DateTemp = CDate(Format$(Date2, "YYYY-MM-DD") & " 09:00:00")
    
27.       lngTime = DateDiff("n", DateTemp, Date2) - IIf(Hour(Date2) > 13, 120, 0)
    
28.      
    
29.       DateTemp = CDate(Format$(Date2, "YYYY-MM-DD") & " 18:00:00")
    
30.       lngTime = lngTime + DateDiff("n", Date1, DateTemp) - IIf(Hour(Date1) < 13, 120, 0)
    
31.     Else
    
32.       lngTime = lngTime + DateDiff("n", Date1, Date2)
    
33.       If (Hour(Date1) < 14) And (Hour(Date2) > 13) Then lngTime = lngTime - 120
    
34.     End If
    
35.    
    
36.     lngDay = lngDay + (lngTime \ 420&)
    
37.     lngTime = lngTime Mod 420
    
38.     Select Case OutMode           '根据OutMode指定的方式输出结果
    
39.       Case 1:     WordDateDiff = Format$(lngDay, "#00:") & Format$(lngTime \ 60, "#00:") & Format(lngTime Mod 60, "00")
    
40.       Case 2:     WordDateDiff = Format$(lngDay * 7 + (lngTime \ 60), "#00小时") & Format(lngTime Mod 60, "00分钟")
    
41.       Case 3:     WordDateDiff = Format$(lngDay, "#00天") & Format$(lngTime \ 60, "#00小时") & Format(lngTime Mod 60, "00分钟")
    
42.       Case Else:  WordDateDiff = Format$(lngDay * 7 + (lngTime \ 60), "#00:") & Format(lngTime Mod 60, "00")
    
43.     End Select
    
44.   End If
    
45. End Function
    
46. Private Function getLegalHoliday(ByVal Date1 As Date, ByVal Date2 As Date) As Long
    
47.   Dim lngNoWorkDay  As Long
    
48.   Dim DateTemp      As Date
    
49.   '本函数目前只处理星期六和星期日，要注意的是每年的法定节日并不相同，如果要此函数能够
    
50.   '       处理所有年份的节假日，则需要数据支持，即每一年的法定节日是怎么放的及调休的……
    
51.   '       这个有点难处理，关键是在于你的假日数据来源是否是正确，否则永远都得不到正确值。
    
52.   DateTemp = Date1
    
53.   Do While DateTemp < Date2
    
54.     Select Case Weekday(DateTemp, vbMonday)
    
55.       Case Is > 5: lngNoWorkDay = lngNoWorkDay + 1
    
56.     End Select
    
57.     DateTemp = DateTemp + 1
    
58.   Loop
    
59.   getLegalHoliday = lngNoWorkDay
    
60. End Function
    

复制代码

这个是测试文档: 时间函数.rar (12.04 KB, 下载次数: 29)

2013-4-11 23:03 上传

点击文件名下载附件
测试文档

张三李四

1. 
   
2. 此函数还有问题，继续修改中。
   
3. Function WeekHour(Firstday As Range, Lastday As Range)
   
4.     If IsDate(Firstday) = False Then
   
5.       WeekHour = False
   
6.       Exit Function
   
7.     End If
   
8.     If IsDate(Lastday) = False Then
   
9.       WeekHour = False
   
10.       Exit Function
    
11.     End If
    
12.     If CDbl(Firstday) > CDbl(Lastday) Then
    
13.       WeekHour = False
    
14.       Exit Function
    
15.     End If
    
16. FirstH = Hour(Firstday)
    
17. LastH = Hour(Lastday)
    
18. FirstM = Minute(Firstday)
    
19. LastM = Minute(Lastday)
    
20. If FirstH < 9 Then FirstH = 9: FirstM = 0: FirstM = 0
    
21. If FirstH > 12 And FirstH < 14 Then FirstM = 14: FirstM = 0
    
22. If FirstH > 18 Then FirstH = 18: FirstM = 0: FirstM = 0
    
23. If LastH < 9 Then LastH = 9: LastM = 0: LastM = 0
    
24. If LastH > 12 And LastH < 14 Then LastH = 14: LastM = 0
    
25. If LastH > 18 Then LastH = 18: LastM = 0: LastM = 0
    
26. Myweekday = Empty
    
27. For H = Firstday To Lastday
    
28.   W = Weekday(H, 2)
    
29.   If W >= 1 And W <= 5 Then
    
30.     Myweekday = Myweekday + 1
    
31.   End If
    
32. Next H
    
33. If Myweekday = 0 Then
    
34.       WeekHour = 0
    
35.       Exit Function
    
36. Else
    
37.           W = Weekday(Firstday, 2)
    
38.           If W < 1 Or W > 5 Then FirstH = 9: FirstM = 0
    
39.           W = Weekday(Lastday, 2)
    
40.           If W < 1 Or W > 5 Then LastH = 18: LastM = 0
    
41.           If FirstH >= 9 And FirstH <= 12 Then
    
42. 
    
43. 
    
44.             FH = FirstH - 9
    
45.           ElseIf FirstH >= 14 And FirstH <= 18 Then
    
46.             FH = FirstH - 14 + 3
    
47.           End If
    
48.          W = Weekday(Lastday, 2)
    
49.          If W < 1 Or W > 5 Then LastH = 18: LastM = 0
    
50.           If LastH >= 9 And LastH <= 12 Then
    
51.             LH = 12 - LastH + 4
    
52.             If LastM <> 0 Then
    
53.               LH = LH - 1
    
54.               LM = 60 - LastM
    
55.             End If
    
56.           ElseIf LastH >= 14 And LastH <= 18 Then
    
57.             LH = 18 - LastH
    
58.             If LastM <> 0 Then
    
59.               LH = LH + 1
    
60.               LM = 60 - LastM
    
61.             End If
    
62.           End If
    
63.           H = LH + FH
    
64.           M = LM + FirstM
    
65.           If M >= 60 Then
    
66.             M = 60 - (M - 60)
    
67.           Else
    
68.             H = H + 1
    
69.             M = 60 - M
    
70.           End If         
    
71.          WeekHour = Format(7 * Myweekday - H & ":" & Format(M, "00"), "h:mm")
    
72. End If
    
73. End Function

复制代码

yygpdkkk

我也上个比较图，供调试参考用：

maditate

再发张图吧。

yygpdkkk

maditate 发表于 2013-4-12 19:15
再发张图吧。

你那是我代码运行的结果？深表怀疑！我相信，即便是我最早最早前上传的代码也不至于得到2:50的结果！！！

事后补：说到joforn版主，早下载他的代码用我的数据去测试了，果不其然，与本人写的代码运行结果有出入（指就当前测试数据而言，本人代码运行正确，其代码运行结果有的正确，有的不正确），由于某些原因，懒得去跟贴，你今拿他的代码运行结果与我的代码运行结果相比较，且有joforn版主代码正确的结论之嫌疑，故明言之。此外，到目前为止，本人坚信，没有他人的代码比我的代码运行结果还正确！！

下图才是我代码运行的结果：


忘了提醒：最后一行的“3:00:00”系4月4日至4月6日为清明节放假，4月7日虽为周日，但已为调休日！！特此声明，免得。。。。

joforn

原来的主函数被我在上传前删除了十来行代码，结果运行结果会出错。这次上传了可以处理2013、2012年节假日的函数，原有Bug已经重新修正。

1. 
   
2. Function WordDateDiff(ByVal Date1 As Date, ByVal Date2 As Date, Optional ByVal OutMode As Long = 0) As String
   
3.   Dim lngTime   As Long, lngDay As Long, DateTemp As Date
   
4.   
   
5.   If IsLegalHoliday(Date1) Then                 '如果起始日期是节假日，推后起始日期至节假后第一天的上班时间
   
6.     Do While IsLegalHoliday(Date1)
   
7.       Date1 = Date1 + 1
   
8.     Loop
   
9.     Date1 = Format$(Date1, "YYYY-MM-DD") & " 09:00:00"
   
10.   Else
    
11.     Select Case Hour(Date1)                     '重新调整起始日期中的时间
    
12.       Case Is < 9:  Date1 = Format$(Date1, "YYYY-MM-DD") & " 09:00:00"
    
13.       Case 12, 13:  Date1 = Format$(Date1, "YYYY-MM-DD") & " 12:00:00"
    
14.       Case Is > 17: Date1 = Format$(Date1, "YYYY-MM-DD") & " 18:00:00"
    
15.     End Select
    
16.   End If
    
17.   
    
18.   If IsLegalHoliday(Date2) Then                 '如果终止日期是节假日，推后起始日期至节假后第一天的上班时间
    
19.     Do While IsLegalHoliday(Date2)
    
20.       Date2 = Date2 + 1
    
21.     Loop
    
22.     Date2 = Format$(Date2, "YYYY-MM-DD") & " 09:00:00"
    
23.   Else
    
24.     Select Case Hour(Date2)                     '重新调整终止日期中的时间
    
25.       Case Is < 9:  Date2 = Format$(Date2, "YYYY-MM-DD") & " 09:00:00"
    
26.       Case 12, 13:  Date2 = Format$(Date2, "YYYY-MM-DD") & " 14:00:00"
    
27.       Case Is > 17: Date2 = Format$(Date2, "YYYY-MM-DD") & " 18:00:00"
    
28.     End Select
    
29.   End If
    
30.   
    
31.   If Date2 < Date1 Then                       '比较调整后的日期是否合法
    
32.     WordDateDiff = "Error:错误的日期输入！"   '终止日期小于起始日期，返回错误提示
    
33.   Else
    
34.     lngDay = DateDiff("d", Date1, Date2) - getLegalHoliday(Date1, Date2) '计算相差的天数
    
35.    
    
36.     '计算出两个工作时间的相差值
    
37.     Date1 = CDate(Format$(Date2, "YYYY-MM-DD") & " " & Format$(Date1, "HH:NN:SS"))
    
38.     If Date1 > Date2 Then
    
39.       lngDay = lngDay - 1
    
40.      
    
41.       DateTemp = CDate(Format$(Date2, "YYYY-MM-DD") & " 09:00:00")
    
42.       lngTime = DateDiff("n", DateTemp, Date2) - IIf(Hour(Date2) > 13, 120, 0)
    
43.      
    
44.       DateTemp = CDate(Format$(Date2, "YYYY-MM-DD") & " 18:00:00")
    
45.       lngTime = lngTime + DateDiff("n", Date1, DateTemp) - IIf(Hour(Date1) < 13, 120, 0)
    
46.     Else
    
47.       lngTime = lngTime + DateDiff("n", Date1, Date2)
    
48.       If (Hour(Date1) < 14) And (Hour(Date2) > 13) Then lngTime = lngTime - 120
    
49.     End If
    
50.    
    
51.     lngDay = lngDay + (lngTime \ 420&)
    
52.     lngTime = lngTime Mod 420
    
53.     Select Case OutMode           '根据OutMode指定的方式输出结果
    
54.       Case 1:     WordDateDiff = Format$(lngDay, "#00:") & Format$(lngTime \ 60, "#00:") & Format(lngTime Mod 60, "00")
    
55.       Case 2:     WordDateDiff = Format$(lngDay * 7 + (lngTime \ 60), "#00小时") & Format(lngTime Mod 60, "00分钟")
    
56.       Case 3:     WordDateDiff = Format$(lngDay, "#00天") & Format$(lngTime \ 60, "#00小时") & Format(lngTime Mod 60, "00分钟")
    
57.       Case Else:  WordDateDiff = Format$(lngDay * 7 + (lngTime \ 60), "#00:") & Format(lngTime Mod 60, "00")
    
58.     End Select
    
59.   End If
    
60. End Function
    
61. 
    
62. Private Function getLegalHoliday(ByVal Date1 As Date, ByVal Date2 As Date) As Long
    
63.   Dim lngNoWorkDay  As Long
    
64.   Dim DateTemp      As Date
    
65.   DateTemp = Date1
    
66.   Do While DateTemp < Date2
    
67.     If IsLegalHoliday(DateTemp) Then lngNoWorkDay = lngNoWorkDay + 1
    
68.     DateTemp = DateTemp + 1
    
69.   Loop
    
70.   getLegalHoliday = lngNoWorkDay
    
71. End Function
    
72. 
    
73. Private Function IsLegalHoliday(ByVal Date1 As Date) As Boolean
    
74.   '本函数目前只能处理2012年及2013年的法定假期，其它年份只判断是否为星期六、星期日。
    
75.   '如果有需要，请自己参照下面的格式，添加其它年份的假期表
    
76.   
    
77.   Date1 = CDate(Format$(Date1, "YYYY-MM-DD"))
    
78.   Select Case Year(Date1)
    
79.     Case 2012
    
80.       Select Case Date1
    
81.         Case #1/1/2012# To #1/3/2012#:    IsLegalHoliday = True: Exit Function  '元旦
    
82.         Case #1/22/2012# To #1/28/2012#:  IsLegalHoliday = True: Exit Function  '春节
    
83.         Case #4/2/2012# To #4/4/2012#:    IsLegalHoliday = True: Exit Function  '清明节
    
84.         Case #4/29/2012# To #5/1/2012#:   IsLegalHoliday = True: Exit Function  '劳动节
    
85.         Case #6/22/2012# To #6/24/2012#:  IsLegalHoliday = True: Exit Function  '端午节
    
86.         Case #9/30/2012# To #10/7/2012#:  IsLegalHoliday = True: Exit Function  '国庆、中秋节
    
87.         Case #1/21/2012#, #1/29/2012#, #3/31/2012#, #1/4/2012#, #4/28/2012#, #9/29/2012#  '调体上班
    
88.           IsLegalHoliday = False: Exit Function
    
89.       End Select
    
90.     Case 2013
    
91.       Select Case Date1
    
92.         Case #1/1/2013# To #1/3/2013#:    IsLegalHoliday = True: Exit Function  '元旦
    
93.         Case #2/9/2013# To #2/15/2013#:   IsLegalHoliday = True: Exit Function  '春节
    
94.         Case #4/4/2013# To #4/6/2013#:    IsLegalHoliday = True: Exit Function  '清明节
    
95.         Case #4/29/2013# To #5/1/2013#:   IsLegalHoliday = True: Exit Function  '劳动节
    
96.         Case #6/10/2013# To #6/12/2013#:  IsLegalHoliday = True: Exit Function  '端午节
    
97.         Case #9/19/2013# To #9/21/2013#:  IsLegalHoliday = True: Exit Function  '中秋节
    
98.         Case #10/1/2013# To #10/7/2013#:  IsLegalHoliday = True: Exit Function  '国庆节
    
99.         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# _
    
100.            , #6/8/2013# To #6/9/2013#, #9/22/2013#, #9/29/2013#, #10/12/2013#  '调体上班
     
101.           IsLegalHoliday = False: Exit Function
     
102.       End Select
     
103.     'Case 2014      '2014年放假表
     
104.     Case Else
     
105.   End Select
     
106.   IsLegalHoliday = Weekday(Date1, vbMonday) > 5
     
107. End Function
     

复制代码

附上测试文档: 时间函数.rar (12.79 KB, 下载次数: 19)

2013-4-12 23:32 上传

点击文件名下载附件

yygpdkkk

joforn 发表于 2013-4-12 22:33
原来的主函数被我在上传前删除了十来行代码，结果运行结果会出错。这次上传了可以处理2013、2012年节假日的 ...

还是有问题！
1.正常的日期误判为“错误的日期输入”，显然代码存在逻辑错误
2.下图工作表第10行的结果多计算了20分钟，显然代码也存在逻辑错误