|
简单写了一个,应该还可以优化,大家跟贴其它方法。
''======================================================
''函数名称: GetLastFriday (获取指定日期所在月的最后星期几是哪一天) 版本:1.01
''调用示例: gf_MsgBox(#2016/10/01#,5)
'' 获取 2016年10月 这月最后一个星期五 是几号
''
''输入参数: (必需)datDate Date 指定日期
'' (必需)lngWeekday Long 星期几,1代表星期一,2代表星期二.... 7代表星期天
''返 回: Date 获得需要的日期
''适应版本: 97,2000,XP,2003,2007,2010,2013,2016 compatible
''作 者: 王宇虹 整理:王宇虹-Office中国
''关 键 字: 最后 月 星期几
''推荐指数: 3
''难度等级: 3
''适应场合: 根据星期取日期
''说 明: 还需测试不同的电脑日期格式对函数结果有否影响
''===================================================
''GUID: 72179DB9-4BBD-.... 编码:023458 创建:2016/09/29 更新:2016/09/29
''===================================================
Public Function GetLastFriday(datDate As Date, lngWeekday As Long) As Date
On Error GoTo Err_Handler
Dim datLastDate As Date
Dim lngLastDateWeekDay As Long
Dim lngDiff As Long
datLastDate = CDate(Year(datDate) & "/" & Month(datDate) & "/01")
datLastDate = DateAdd("m", 1, datLastDate) - 1
lngLastDateWeekDay = Weekday(datLastDate, vbMonday)
If lngLastDateWeekDay >= lngWeekday Then
lngDiff = lngLastDateWeekDay - lngWeekday
Else
lngDiff = lngLastDateWeekDay + 7 - lngWeekday
End If
GetLastFriday = DateAdd("d", -lngDiff, datLastDate)
Exit Function
Err_Handler:
MsgBox "GetLastFriday Error:" & Err.Description
End Function
|
|