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

娃泰贤

计算 例如：发起时间（4月8号 11点01分）到 结束时间（4月9号 15点23分） 所花费的时间？ 最终时间是  9小时22分
（只计算以下时间范围内的时间：----工作日（周一到周五）---工作时间段（9点~12点，14点~18点））
用函数 怎么写啊  
还需要补充的一点是
发起时间（4月8号 12点）到 结束时间（4月9号 20点） 时间只计算4月8号（14点~18点）--4小时；4月9号 工作时间段（9点~12点，14点~18点）---7小时
时间为13小时，
18点到20点 不在工作时间内 不计算

有时间的高人 可查看附件

maditate

这个复杂的计算式，呵呵

yygpdkkk

为此题花了7、8个小时，晕死。
另：代码未经严格测试（短时间内考虑不到那么多细节数据）
代码更新：经再次分析、理顺思路，修改了部分代码，进而发现修正时长的代码不再必要，故代码逻辑应该严谨了些
代码再次更新：再次删减了些代码，同时增加了处理2003年法定节假日及调休日的函数代码

最新说明：本楼判断是否工作日的代码在速度上大大逊色于joforn的写法（提示：若跨越日期很长，就看出显著区别了。尽管实际应用中不可能出现日期跨越4万多天，但代码毕竟表现出了速度上的区别），故于27楼处对本楼代码作了相应修改，也改为Select结构，直接列示节假日。此外，直接列示的节假日采用日期文字还有个好处，即增加了语言上的可移植性。

1. 
   
2. 
   
3. Function MyTime(theStartDate As Variant, theEndDate As Variant) As Variant
   
4.     Dim theDate1 As Date, theDate2 As Date, theTime1 As Date, theTime2 As Date, i&
   
5.     MyTime = 0 '确保一次赋值
   
6.     If Not IsDate(theStartDate) Or Not IsDate(theEndDate) Then '若非法日期，则
   
7.         MyTime = CVErr(xlErrNA) '返回错误值
   
8.         Exit Function
   
9.     End If
   
10.     If theEndDate - theStartDate < 0 Then
    
11.         MyTime = CVErr(xlErrNA) '若发起时间大于结束时间，则返回错误值
    
12.         Exit Function
    
13.     End If
    
14.     theDate1 = DateSerial(Year(theStartDate), Month(theStartDate), Day(theStartDate))
    
15.     theTime1 = theStartDate - theDate1
    
16.     theDate2 = DateSerial(Year(theEndDate), Month(theEndDate), Day(theEndDate))
    
17.     theTime2 = theEndDate - theDate2
    
18.     Select Case theTime1 '确定发起时间（仅指时间部分，不含日期）
    
19.         Case Is < TimeValue("9:00:01") '若发起时间早于上午9点，则确定为9点起始
    
20.             theTime1 = TimeValue("9:00:00")
    
21.         Case Is < TimeValue("12:00:01") '若发起时间早于正午，则theTime1就是发起时间，不用调整
    
22.         Case Is < TimeValue("14:00:01") '若发起时间早于下午14点，则确定为12点起始（此处很重要）
    
23.             theTime1 = TimeValue("12:00:00")
    
24.         Case Is < TimeValue("18:00:01") '若发起时间早于下午18点，则theTime1就是发起时间，不用调整
    
25.         Case Else '否则确定为18:00:00
    
26.             theTime1 = TimeValue("18:00:00")
    
27.     End Select
    
28.     Select Case theTime2 '确定结束时间（仅指时间部分，不含日期）
    
29.         Case Is < TimeValue("9:00:01") '若结束时间早于上午9点，则确定为上午9:00:00
    
30.             theTime2 = TimeValue("9:00:00")
    
31.         Case Is < TimeValue("12:00:01") '若结束时间早于正午，则theTime2就是结束时间，不用调整
    
32.         Case Is < TimeValue("14:00:01") '若结束时间早于下午14点零1分，则确定为中午12点结束（此处很重要）
    
33.             theTime2 = TimeValue("12:00:00") '（承上述）此处故意把结束时间往早前推（不设为14:00:00），
    
34.             '从而与theTime1的12:00:00这一时间点重叠，巧妙地使后续代码的时间相减融为一体，从而不用再专门写代码进行修正
    
35.         Case Is < TimeValue("18:00:01") '若结束时间早于下午18点，则theTime2就是结束时间，不用调整
    
36.         Case Else '否则确定为18:00:00
    
37.             theTime2 = TimeValue("18:00:00")
    
38.     End Select
    
39.     If theDate1 = theDate2 Then '若发起日期与结束日期为同一天，则
    
40.         If MyWorkDay(theDate1) Then '若为工作日，则
    
41.             If theTime1 < TimeValue("12:00:01") Then
    
42.                 If theTime2 < TimeValue("14:00:01") Then
    
43.                     MyTime = theTime2 - theTime1 '两个时间均处于上午，则直接相减
    
44.                 Else
    
45.                     MyTime = TimeValue("12:00:00") - theTime1 '先计算出上午时长
    
46.                     MyTime = MyTime + theTime2 - TimeValue("14:00:00") '再加上下午时长
    
47.                 End If
    
48.             Else '否则，两个时间均处于下午
    
49.                  MyTime = theTime2 - theTime1 '仅下午时长
    
50.             End If
    
51.         End If
    
52.     Else '否则，发起日期与结束日期不为同一天
    
53.         If MyWorkDay(theDate1) Then '先计算发起日的时长
    
54.             If theTime1 < TimeValue("12:00:01") Then
    
55.                 MyTime = TimeValue("12:00:00") - theTime1 '先计算出上午时长
    
56.                 MyTime = MyTime + TimeValue("4:00:00") '再加上下午时长
    
57.             Else '否则，计算发起日的下午时长
    
58.                 MyTime = TimeValue("18:00:00") - theTime1 '仅存在下午时长
    
59.             End If
    
60.         End If
    
61.         If MyWorkDay(theDate2) Then '再计算结束日的时长
    
62.             If theTime2 < TimeValue("12:00:01") Then '计算结束日的上午时长
    
63.                 MyTime = MyTime + theTime2 - TimeValue("9:00:00") '仅存在上午时长
    
64.             Else '否则计算结束日的时长
    
65.                 MyTime = MyTime + TimeValue("3:00:00") + theTime2 - TimeValue("14:00:00") '上午3小时和下午时长
    
66.             End If
    
67.         End If
    
68.     End If
    
69.     For i = theDate1 + 1 To theDate2 - 1 '介于发起日和结束日之间的其他天数必定为7小时
    
70.         If MyWorkDay(CDate(i)) Then
    
71.             MyTime = MyTime + TimeValue("7:00:00")
    
72.         End If
    
73.     Next i
    
74. End Function
    
75. Private Function MyWorkDay(theDate As Date) As Boolean
    
76.     '本函数当前内置数据仅适用于公元2013年
    
77.     Dim arr As Variant '指按《全国年节及纪念日放假办法》规定安排的全年公休假放假安排
    
78.     Dim brr As Variant '同上，用于调休日，即周六、周日因调休而成工作日
    
79.     Dim theWorkDay As Boolean '是否调休日标记
    
80.     Dim i&
    
81.     arr = Array("2013-1-1", "2013-1-2", "2013-1-3", "2013-2-9", "2013-2-10", "2013-2-11", "2013-2-12", "2013-2-13", "2013-2-14", "2013-2-15", "2013-4-4", "2013-4-5", "2013-4-6", "2013-4-29", "2013-4-30", "2013-5-1", "2013-6-10", "2013-6-11", "2013-6-12", "2013-9-19", "2013-9-20", "2013-9-21", "2013-10-1", "2013-10-2", "2013-10-3", "2013-10-4", "2013-10-5", "2013-10-6", "2013-10-7") '法定节假日在此指定
    
82.     brr = Array("2013-1-5", "2013-1-6", "2013-2-16", "2013-2-17", "2013-4-7", "2013-4-27", "2013-4-28", "2013-6-8", "2013-6-9", "2013-9-22", "2013-9-29", "2013-10-12") '调休日在此指定（指周六、周日因调休而成工作日）
    
83.     If Weekday(theDate, vbMonday) < 6 Then '若为周一至周五，则进一步检查是否为节假日
    
84.         theWorkDay = True '赋初值，即先假定为是正常的工作日
    
85.         For i = LBound(arr) To UBound(arr)
    
86.             If theDate = CDate(arr(i)) Then '若是节假日，则
    
87.                 theWorkDay = False
    
88.                 Exit For
    
89.             End If
    
90.         Next i
    
91.     Else '否则，为周六或周日，则进一步检查是否调休日
    
92.         For i = LBound(brr) To UBound(brr)
    
93.             If theDate = CDate(brr(i)) Then '若是调休日，则
    
94.                 theWorkDay = True
    
95.                 Exit For
    
96.             End If
    
97.         Next i
    
98.     End If
    
99.     If theWorkDay Then MyWorkDay = True Else MyWorkDay = False
    
100. End Function
     
101. 
     
102. 
     

复制代码

上个图（罗列的数据应该还算详细了吧。另注：黄色底纹系特意提醒注意该行所举数据的特殊性，无它）：

娃泰贤

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

太谢谢啦！高人了，看到你的回复真的是惊喜啊， 我正在测试中

张三李四

  15楼代码重发。。。。。

蓝桥玄霜

1. Sub lqxs()
   
2. Dim ks, js, kssj, jssj, rq, sw
   
3. ks = [a1].Value
   
4. js = [a2].Value
   
5. kssj = Split(ks)
   
6. jssj = Split(js)
   
7. rq = DateDiff("d", ks, js)
   
8. If rq > 0 Then
   
9.     If CDate(kssj(1)) < #6:00:00 PM# Then
   
10.         If CDate(kssj(1)) < #12:00:00 PM# Then
    
11.             If CDate(kssj(1)) > #9:00:00 AM# Then
    
12.                 sw = DateDiff("h", CDate(kssj(1)), #12:00:00 PM#) + 4
    
13.             Else
    
14.                 sw = 7
    
15.             End If
    
16.         ElseIf CDate(kssj(1)) > #2:00:00 PM# Then
    
17.             sw = DateDiff("h", CDate(kssj(1)), #6:00:00 PM#)
    
18.         Else
    
19.             sw = 4
    
20.         End If
    
21.     End If
    
22.     If CDate(jssj(1)) <= #12:00:00 PM# Then
    
23.         If CDate(jssj(1)) > #9:00:00 AM# Then
    
24.             sw = sw + DateDiff("h", #9:00:00 AM#, CDate(jssj(1)))
    
25.         End If
    
26.     Else
    
27.         If CDate(jssj(1)) <= #6:00:00 PM# Then
    
28.             If CDate(jssj(1)) > #2:00:00 PM# Then
    
29.                 sw = sw + DateDiff("h", #2:00:00 PM#, CDate(jssj(1))) + 3
    
30.             End If
    
31.         Else
    
32.             sw = sw + 7
    
33.         End If
    
34.     End If
    
35.     sw = sw + 7 * (rq - 1)
    
36. Else
    
37.         If CDate(kssj(1)) < #11:59:00 AM# Then
    
38.             If CDate(kssj(1)) > #9:00:00 AM# Then
    
39.                 sw = DateDiff("h", CDate(kssj(1)), #12:00:00 PM#)
    
40.                 If CDate(jssj(1)) <= #6:00:00 PM# Then
    
41.                     If CDate(jssj(1)) > #2:00:00 PM# Then
    
42.                         sw = sw + DateDiff("h", #2:00:00 PM#, CDate(jssj(1)))
    
43.                     End If
    
44.                 Else
    
45.                     sw = sw + 4
    
46.                 End If
    
47.             End If
    
48.         ElseIf CDate(kssj(1)) > #2:00:00 PM# Then
    
49.             If CDate(kssj(1)) <= #6:00:00 PM# Then
    
50.                 If CDate(jssj(1)) <= #6:00:00 PM# Then
    
51.                     sw = sw + DateDiff("h", CDate(kssj(1)), CDate(jssj(1)))
    
52.                 Else
    
53.                     sw = DateDiff("h", CDate(kssj(1)), #6:00:00 PM#)
    
54.                 End If
    
55.             Else
    
56.                 sw = 0
    
57.             End If
    
58.         Else
    
59.                 If CDate(jssj(1)) <= #6:00:00 PM# Then
    
60.                     sw = DateDiff("h", #2:00:00 PM#, CDate(jssj(1)))
    
61.                 Else
    
62.                     sw = 4
    
63.                 End If
    
64.         End If
    
65. End If
    
66. MsgBox sw
    
67. End Sub
    

复制代码

蓝桥玄霜

请见附件。

娃泰贤

蓝桥玄霜 发表于 2013-4-11 10:13
请见附件。

非常谢谢版主的关注，需求中 还需要判断周六日或者如在代码加上中国的法定节假日 ，这个还需要加什么的代码呢，因为这是需要批量处理，按钮如何切换成更快捷的方式，期待 版主的指点。

娃泰贤

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

高手 能不能发给文档 给我看看学习 学习
因为 我才开始学VBA 你的代码复制到宏里 无法启动
  期待你的回复

娃泰贤

张三李四 发表于 2013-4-11 09:20

谢谢 高手的支持  因为才开始学习VBA  但代码复制进去 有问题
  你看 可不可以 发个文档呢! 再次谢谢