VBA -试图找到给定月的第一个星期一

Question

我想知道如何得到一个月的第一个星期一。我有以下代码给我的第一个星期一的月，但我需要确定第一个星期一是否落在前一个月。如果一个月的第一天是星期一到星期三，那么第一个星期一就是当周。如果第一天为星期四至星期日，则第一个星期一为下一个星期一。

Public Function FirstMonday(myDate As Date) As Date
Dim d As Date, w As Long
d = DateSerial(Year(myDate), month(myDate), 1)
w = Weekday(d, vbMonday)
FirstMonday = d + IIf(w <> 1, 8 - w, 0)
End Function

以2021年8月为例-第一个星期一将是02/08/2021，因为该月的第一天是星期日(即周三之后)。

2021年9月-第一个星期一将是30/08/2021，因为该月的第一天是星期三。

2021年10月-第一个星期一将是04/10/2021，因为该月的第一天是星期五。

如果能提供任何帮助，那就太好了。

提前感谢，

那么默契

Answer 1

分解你的问题，你真正想要的是这个月的第一个星期三之前的星期一

所以，只要找到第一个星期三然后减去两天!!不需要使用If ... Else语句使事情过于复杂。

Public Function FirstMonday(myDate As Date) As Date
Dim d As Date, w As Long
d = DateSerial(Year(myDate), Month(myDate), 1)
w = Weekday(d, vbThursday)  'Thursday = 1, Friday = 2, Wednesday = 7
d = d + 7 - w               'Adjusts d from being first day to first wednesday
FirstMonday = d - 2         'The Monday before
End Function

Answer 2

你差一点。对于您的测试日期，这给了我预期的响应:

Public Function FirstMonday(myDate As Date) As Date
Dim d As Date, w As Long
d = DateSerial(Year(myDate), Month(myDate), 1)
w = Weekday(d, vbMonday)
If w > 3 Then
FirstMonday = d + (8 - w)
Else
FirstMonday = d - w + 1
End If
End Function

当w > 3时，一个月的第一天是星期四到星期天。在这种情况下，将缺失的天数添加到下一个星期一(8 - w)。否则，返回并减去w - 1以得到前一周的星期一。

Answer 3

试试这个版本:

Public Function FirstMonday(myDate As Date) As Date
Dim d As Date, w As Long
d = DateSerial(Year(myDate), Month(myDate), 1)
w = Weekday(d, vbMonday)
If w >= 1 And w <= 3 Then d = d - 7
FirstMonday = d + 8 - w
End Function

d将保存每月第一天的日期
w将获取该日期的星期几(星期一=1，星期日=7)
当星期几为星期一至星期三(w为1..3)时，我们返回一周(d = d - 7)。
使用该日期，我们计算下星期一(d + 8 - w)。

结果如下:

月的第一天	第一个星期一
January	2021年1月1日星期五	2021年1月4日星期一
二月	2021年2月1日星期一	2021年2月1日星期一
March	2021年3月1日星期一	2021年3月1日星期一
April	2021年4月1日星期四	2021年4月5日星期一
五月	2021年5月1日星期六	2021年5月3日星期一
June	2021年6月1日星期二	2021年5月31日星期一
July	2021年7月1日星期四	2021年7月5日星期一
八月	2021年8月1日星期日	2021年8月2日星期一
九月	2021年9月1日星期三	2021年8月30日星期一
十月	2021年10月1日星期五	2021年10月4日星期一
十一月	2021年11月1日星期一	2021年11月1日星期一
十二月	2021年12月1日星期三	2021年11月29日星期一

我没有发现最后一个例子适用于所有日期。这是一个调整后的版本，将适用于所有日期:

Public Function FirstMonday(myDate As Date)
Dim d As Date, w As Long
d = DateSerial(Year(myDate), Month(myDate), 1)
w = Weekday(d) ' Monday = 2
Do Until w = 2
d = d + 1
w = Weekday(d)
Loop
' now have first Monday for d
FirstMonday = d
End Function