如何获取当月的星期一（完整日期）？
How to get the Mondays (full date) in the current month?
我正在尝试获取当月所有星期一的日期。例如，在当前月份 2021 年 5 月，我们将有：3/05/2021、10/05/2021、17/05/2021、24/05/2021、31/05/2021。
经过调查，我找到了一个旧问题的答案，这有助于
，但是这显示 6 作为答案。哪个是正确的（参见共享日历）。但是我只想计算这个月的星期一。
我还有一个补充代码，它给出了一个月中星期一的数量：
Sub NumMondays()
Dim i As Integer
Dim num_mondays As Integer
Dim test_date As Date
Dim orig_month As Integer
month_name = Format(Date, "mmmm")
year_name = Format(Date, "yyyy")
' Get the first day of the month.
test_date = CDate(month_name & " 1, " & year_name)
' Count the Mondays.
orig_month = Month(test_date)
Do
num_mondays = num_mondays + 1
test_date = DateAdd("ww", 1, test_date)
Loop While (Month(test_date) = orig_month)
Debug.Print test_date
Debug.Print orig_month
Debug.Print num_mondays
End Sub
这样的代码打印 5 表示周一的数量，但是我无法将其转换为此类周一的实际日期。有什么建议吗？
非常感谢
请尝试下一个代码：
Sub NumMondays()
Dim i As Long, month_name, year_name, num_mondays As Integer
Dim test_date As Date, orig_month As Integer, arrMondays, k As Long
month_name = Format(Date, "mmmm")
year_name = Format(Date, "yyyy")
' Get the first day of the month.
test_date = CDate(month_name & " 1, " & year_name)
orig_month = month(test_date)
ReDim arrMondays(4)
'extract and count Mondays:
Do
If Weekday(test_date, vbMonday) = 1 Then
arrMondays(k) = test_date: k = k + 1: num_mondays = num_mondays + 1
End If
test_date = test_date + 1
Loop While (month(test_date) = orig_month)
ReDim Preserve arrMondays(k - 1)
Debug.Print "Current month no = " & orig_month
Debug.Print "No of Mondays = " & num_mondays
Debug.Print Join(arrMondays, ", ")
End Sub
不同的方法。有一个有点为人所知的 Excel 公式，它提供给定周数和年份的星期一 (=DATE(A2, 1, -2) - WEEKDAY(DATE(A2, 1, 3)) + B2 * 7) [ A2 是年份，B2 是周数]。在这种情况下，我在一个月内循环所有周，并在每周使用该公式。
Sub CaseOfTheMondays()
Dim inDate As Date, sDate As Date, eDate As Date, sYear As Date, mDate As Date
Dim cMonth As Integer, i As Integer, x As Integer
inDate = InputBox("Enter a valid date")
If IsDate(inDate) Then
ThisWorkbook.Worksheets(1).Columns("A").ClearContents
sDate = DateAdd("d", -(Format(inDate, "d") - 1), inDate)
eDate = DateAdd("m", 1, inDate) - (Format(inDate, "d") + 1)
sYear = DateAdd("m", -(Format(inDate, "m") - 1), DateAdd("d", -(Format(inDate, "d") - 1), inDate))
cMonth = Format(inDate, "m")
sWeek = WorksheetFunction.WeekNum(sDate, vbMonday)
eWeek = WorksheetFunction.WeekNum(eDate, vbMonday)
x = 1
For i = sWeek To eWeek
mDate = DateAdd("d", -3, sYear) - Weekday(DateAdd("d", 2, sYear)) + (i * 7)
If Format(mDate, "m") = cMonth Then
ThisWorkbook.Worksheets(1).Cells(x, 1).Value = mDate
x = x + 1
End If
Next i
Else
MsgBox "invalid date"
End If
End Sub
蛮力方法
Sub tester()
Dim dt
For Each dt In GetDayDates(2021, 5, "Mon")
Debug.Print dt
Next dt
End Sub
Function GetDayDates(yr As Long, mon As Long, d As String)
Dim dt As Date, col As New Collection
dt = DateSerial(yr, mon, 1)
Do While Month(dt) = mon
If Format(dt, "ddd") = d Then col.Add dt
dt = dt + 1
Loop
Set GetDayDates = col
End Function
功能性解决方案
一个好的方法是使用一个函数，该函数将 return 指定月份的天数集合。
这与提供的其他方法类似 — 然而，这增加了一些性能，更重要的是 intellisense 用于星期几。
Public Function GetMonthDays(dayToGet As VbDayOfWeek _
, monthToGetFrom As Long _
, yearToGetFrom As Long) As Collection
Set GetMonthDays = New Collection
' First Starting date, and will be used
' for incrementing to next date/next day.
Dim nextDate As Date
nextDate = DateSerial(yearToGetFrom, monthToGetFrom, 1)
' Loop until month changes to next month.
Do While month(nextDate) = monthToGetFrom
' If weekday matches, then add and
' increment to next week (7 days)
If Weekday(nextDate) = dayToGet Then
GetMonthDays.Add nextDate
nextDate = nextDate + 7
' Day did not match, therefore increment
' 1 day until it does match.
Else
nextDate = nextDate + 1
End If
Loop
End Function
例子
这是一个基本的使用示例。
Sub testGetMonthDays()
Dim mondayDate As Variant
For Each mondayDate In GetMonthDays(vbMonday, month(Date), year(Date))
Debug.Print mondayDate
Next
End Sub
5/3/2021
5/10/2021
5/17/2021
5/24/2021
5/31/2021
我正在尝试获取当月所有星期一的日期。例如，在当前月份 2021 年 5 月，我们将有：3/05/2021、10/05/2021、17/05/2021、24/05/2021、31/05/2021。
经过调查，我找到了一个旧问题的答案，这有助于
我还有一个补充代码，它给出了一个月中星期一的数量：
Sub NumMondays()
Dim i As Integer
Dim num_mondays As Integer
Dim test_date As Date
Dim orig_month As Integer
month_name = Format(Date, "mmmm")
year_name = Format(Date, "yyyy")
' Get the first day of the month.
test_date = CDate(month_name & " 1, " & year_name)
' Count the Mondays.
orig_month = Month(test_date)
Do
num_mondays = num_mondays + 1
test_date = DateAdd("ww", 1, test_date)
Loop While (Month(test_date) = orig_month)
Debug.Print test_date
Debug.Print orig_month
Debug.Print num_mondays
End Sub
这样的代码打印 5 表示周一的数量，但是我无法将其转换为此类周一的实际日期。有什么建议吗？
非常感谢
请尝试下一个代码：
Sub NumMondays()
Dim i As Long, month_name, year_name, num_mondays As Integer
Dim test_date As Date, orig_month As Integer, arrMondays, k As Long
month_name = Format(Date, "mmmm")
year_name = Format(Date, "yyyy")
' Get the first day of the month.
test_date = CDate(month_name & " 1, " & year_name)
orig_month = month(test_date)
ReDim arrMondays(4)
'extract and count Mondays:
Do
If Weekday(test_date, vbMonday) = 1 Then
arrMondays(k) = test_date: k = k + 1: num_mondays = num_mondays + 1
End If
test_date = test_date + 1
Loop While (month(test_date) = orig_month)
ReDim Preserve arrMondays(k - 1)
Debug.Print "Current month no = " & orig_month
Debug.Print "No of Mondays = " & num_mondays
Debug.Print Join(arrMondays, ", ")
End Sub
不同的方法。有一个有点为人所知的 Excel 公式，它提供给定周数和年份的星期一 (=DATE(A2, 1, -2) - WEEKDAY(DATE(A2, 1, 3)) + B2 * 7) [ A2 是年份，B2 是周数]。在这种情况下，我在一个月内循环所有周，并在每周使用该公式。
Sub CaseOfTheMondays()
Dim inDate As Date, sDate As Date, eDate As Date, sYear As Date, mDate As Date
Dim cMonth As Integer, i As Integer, x As Integer
inDate = InputBox("Enter a valid date")
If IsDate(inDate) Then
ThisWorkbook.Worksheets(1).Columns("A").ClearContents
sDate = DateAdd("d", -(Format(inDate, "d") - 1), inDate)
eDate = DateAdd("m", 1, inDate) - (Format(inDate, "d") + 1)
sYear = DateAdd("m", -(Format(inDate, "m") - 1), DateAdd("d", -(Format(inDate, "d") - 1), inDate))
cMonth = Format(inDate, "m")
sWeek = WorksheetFunction.WeekNum(sDate, vbMonday)
eWeek = WorksheetFunction.WeekNum(eDate, vbMonday)
x = 1
For i = sWeek To eWeek
mDate = DateAdd("d", -3, sYear) - Weekday(DateAdd("d", 2, sYear)) + (i * 7)
If Format(mDate, "m") = cMonth Then
ThisWorkbook.Worksheets(1).Cells(x, 1).Value = mDate
x = x + 1
End If
Next i
Else
MsgBox "invalid date"
End If
End Sub
蛮力方法
Sub tester()
Dim dt
For Each dt In GetDayDates(2021, 5, "Mon")
Debug.Print dt
Next dt
End Sub
Function GetDayDates(yr As Long, mon As Long, d As String)
Dim dt As Date, col As New Collection
dt = DateSerial(yr, mon, 1)
Do While Month(dt) = mon
If Format(dt, "ddd") = d Then col.Add dt
dt = dt + 1
Loop
Set GetDayDates = col
End Function
功能性解决方案
一个好的方法是使用一个函数，该函数将 return 指定月份的天数集合。
这与提供的其他方法类似 — 然而，这增加了一些性能，更重要的是 intellisense 用于星期几。
Public Function GetMonthDays(dayToGet As VbDayOfWeek _
, monthToGetFrom As Long _
, yearToGetFrom As Long) As Collection
Set GetMonthDays = New Collection
' First Starting date, and will be used
' for incrementing to next date/next day.
Dim nextDate As Date
nextDate = DateSerial(yearToGetFrom, monthToGetFrom, 1)
' Loop until month changes to next month.
Do While month(nextDate) = monthToGetFrom
' If weekday matches, then add and
' increment to next week (7 days)
If Weekday(nextDate) = dayToGet Then
GetMonthDays.Add nextDate
nextDate = nextDate + 7
' Day did not match, therefore increment
' 1 day until it does match.
Else
nextDate = nextDate + 1
End If
Loop
End Function
例子
这是一个基本的使用示例。
Sub testGetMonthDays()
Dim mondayDate As Variant
For Each mondayDate In GetMonthDays(vbMonday, month(Date), year(Date))
Debug.Print mondayDate
Next
End Sub
5/3/2021
5/10/2021
5/17/2021
5/24/2021
5/31/2021