Office中国论坛/Access中国论坛

标题: 周日期起止时间函数 [打印本页]

作者: a63521557 时间: 2015-7-4 09:32
标题: 周日期起止时间函数
给某企业做周薪核算管理系统，需用到周日期起止时间，特做了一个“周日期起止时间函数”，在此分享。

'获取每周起始日期(周日期天数约定：每年第一天为第一周，每周第一天为星期一，
'每年除第一周和最后一周可以不为七天外，其余各周每周均为七天)
'用法示例：周日期(2015,27)，返回2015年第27周起止日期：2015/6/29～2015/7/5
Function 周日期(yyyy0 As Integer, ww0 As Integer) As String
Dim RQ1 As Date, RQ2 As Date, RQ3 As Date
Dim ww1 As Integer

RQ1 = CDate(yyyy0 & "-1-1") '某年的第一天日期
RQ2 = DateAdd("d", 7 - Weekday(RQ1, vbMonday), RQ1)  '某年的第一周末日期
RQ3 = CDate(yyyy0 & "-12-31")  '某年的最后一天日期
ww1 = DatePart("ww", RQ3, vbMonday, vbFirstJan1) '某年的最后一周

If ww0 > ww1 Or ww0 < 1 Then
      MsgBox "输入的周数超出了" & yyyy0 & "年的周数范围：1～" & ww1, vbOKOnly + vbCritical, "输入数据出错"
      周日期 = "输入周数有误"
ElseIf ww0 = 1 Then    '某年的第一周日期
      周日期 = RQ1 & "～" & RQ2
ElseIf ww0 = ww1 Then '某年的最后一周日期
      周日期 = DateAdd("d", (ww0 - 2) * 7 + 1, RQ2) & "～" & RQ3
Else
      周日期 = DateAdd("d", (ww0 - 2) * 7 + 1, RQ2) & "～" & DateAdd("d", (ww0 - 1) * 7, RQ2)
End If

End Function
[attach]56751[/attach]

作者: 风中漫步 时间: 2015-7-4 10:11
谢谢分享

作者: fjh 时间: 2015-7-6 16:06
看看

作者: zz-lilu 时间: 2015-7-7 15:11
学习学习

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