周日期起止时间函数

来源:原创 点击数:9336 　 | 收藏 | 复制

时　间:2015-07-04 09:37:23
作　者:a63521557 ID：373 城市：重庆
摘　要:获取每周起始日期(周日期天数约定：每年第一天为第一周，每周第一天为星期一，每年除第一周和最后一周可以不为七天外，其余各周每周均为七天)
用法示例：周日期(2015,27)
返回2015年第27周起止日期：2015/6/29～2015/7/5
正　文:

'获取每周起始日期(周日期天数约定：每年第一天为第一周，每周第一天为星期一，
'每年除第一周和最后一周可以不为七天外，其余各周每周均为七天)
'用法示例：周日期(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

Access软件网官方交流QQ群 (群号:54525238) 　　　　　　Access源码网店

【打印此文】【关闭窗口】