В последнюю субботу октября
Функция
Function LSat10(Year As Long) As Date
Dim i As Long
Dim vntDate As Date
vntDate = DateSerial(Year, 10, 31)
For i = 0 To 6
If Weekday(vntDate - i) = 7 Then Exit For
Next
LSat10 = vntDate - i
End Function
РЕДАКТИРОВАТЬ (2019-02-12)
Как TM указано в комментарияхесть лучшее решение, использующее функцию Weekday:
Function LSat10(Year As Long) As Date
Dim vntDate As Date
vntDate = DateSerial(Year, 10, 31)
LSat10 = vntDate - (Weekday(vntDate) Mod 7)
End Function
Хотя это, вероятно, лучшее решение, оно «привязано» к аргументу firstdayofweek функции Weekday с помощью по умолчанию установлен на 1 (vbSunday), где седьмой день «случайно» суббота.
Для дальнейшего развития функции для других дней и месяцев, подход в Решение из user11040196 намного лучше (относительно использования 1-го числа следующего месяца): последний день месяца может быть 28-31 , но первый деньможет быть только 1 .
Дата последнего дня месяца
Этот подход я использовал при разработке следующей функции, которая вычисляет последнюю дату любого (неделю) день любого месяца любого года (4-значные годы 1900-9999 поддерживаются в Excel. 2-значные годы не охватываются.).У этого есть три аргумента: (неделя) день, месяц и год, все введенные как числа.Разрабатывая его, я был слишком поглощен тем, что мог ввести пользователь, поэтому он стал больше изучать Variant, IsMissing и некоторые другие методы «обработки ошибок».
Код
'*******************************************************************************
' Purpose: Returns the date of a last weekday of a month of a year.
' Inputs
' dmlWeekDay: Depending on the FirstDayOfWeek constant, it is the numeric
' presentation of a weekday e.g. if FirstDayOfWeek is 1 (for
' US, CA, JP), 1 is Sunday, 2 is Monday , 3 is Tuesday etc.
' dmlMonth: The numeric presentation of a month.
' dmlYear: A specified year.
' FirstDayOfWeek as Constant: This argument has been left as a constant
' on purpose, so it has to be changed directly in the code.
' For US or wherever the FDoW is Sunday, use 1. For EU or
' wherever the FDoW is Monday, use 2. For ME or wherever the
' FDoW is Saturday, use 7 etc.
' Returns: A Date when dmlWeekday and dmlMonth are literally any number
' or omitted and dmlYear is any positive or negative number from
' 1900-9999 or omitted. An empty string ("") otherwise.
'*******************************************************************************
Function DAYMONL(Optional ByVal dmlWeekDay, Optional ByVal dmlMonth, _
Optional ByVal dmlYear)
' First Day of Week
Const FirstDayOfWeek As Long = 1 ' 1 (Sunday), 2 (Monday), 7 (Saturday)
Dim vntDay As Variant ' Weekday "firstdayofweek" Parameter Array
Dim dt As Date ' 1st of Next Month
DAYMONL = "" ' To return after Exit Function.
' Choose Weekday "firstdayofweek" Parameter Array.
Select Case FirstDayOfWeek
Case 1: vntDay = Array(7, 1, 2, 3, 4, 5, 6) ' Sunday: US, CA, JP
Case 2: vntDay = Array(6, 7, 1, 2, 3, 4, 5) ' Monday: EU
Case 7: vntDay = Array(1, 2, 3, 4, 5, 6, 7) ' Saturday: ME
'Case 3: vntDay = Array(5, 6, 7, 1, 2, 3, 4) ' Tuesday:
'Case 4: vntDay = Array(4, 5, 6, 7, 1, 2, 3) ' Wednesday:
'Case 5: vntDay = Array(3, 4, 5, 6, 7, 1, 2) ' Thursday:
'Case 6: vntDay = Array(2, 3, 4, 5, 6, 7, 1) ' Friday:
Case Else: MsgBox "Wrong FirstDayOfWeek parameter.": Exit Function
End Select
' Weekday
If IsMissing(dmlWeekDay) Then
dmlWeekDay = WeekDay(Date) ' Today('s (Week)Day)
Else
' Ensure that dmlWeekDay is a number.
If Not IsNumeric(dmlWeekDay) Then Exit Function
' Int ensures whole number.
' Abs ensures positive number.
' Mod ensures number from 1 to 7.
dmlWeekDay = Abs(Int(dmlWeekDay)) Mod 7
' 0 is useless, 7 is needed.
If dmlWeekDay = 0 Then dmlWeekDay = 7
'dmlWeekDay = Int(dmlWeekDay)
'If dmlWeekDay < 1 Or dmlWeekDay > 7 Then Exit Function
End If
' Month
If IsMissing(dmlMonth) Then
dmlMonth = Month(Date) ' Today's Month
Else
' Ensure that dmlMonth is a number.
If Not IsNumeric(dmlMonth) Then Exit Function
' Int ensures whole number.
' Abs ensures positive number.
' Mod ensures number from 1 to 12.
dmlMonth = Abs(Int(dmlMonth)) Mod 12
' 0 is useless, 12 is needed.
If dmlMonth = 0 Then dmlMonth = 12
'dmlMonth = Int(dmlMonth)
'If dmlMonth < 1 Or dmlMonth > 12 Then Exit Function
End If
' Year
If IsMissing(dmlYear) Then
dmlYear = Year(Date) ' Today's dmlYear
Else
' Ensure that dmlYear is a number.
If Not IsNumeric(dmlYear) Then Exit Function
' Int ensures whole number.
' Abs ensures positive number.
dmlYear = Abs(Int(dmlYear))
' Ensure dmlYear is a number from 1900 to 9999.
If dmlYear < 1900 Or dmlYear > 9999 Then Exit Function
If dmlYear = 9999 And dmlMonth = 12 Then
' Excel doesn't support dates greater than 12/31/9999.
' The following "dmlMonth + 1" would produce an error.
DAYMONL = DateSerial(9999, 12, 24 _
+ Application.Match(dmlWeekDay, vntDay, 0))
Exit Function
End If
End If
' Write the date of the 1st of next month to a variable.
dt = DateSerial(dmlYear, dmlMonth + 1, 1)
' Subtract the match (position) of dmlWeekday in Weekday "firstdayofweek"
' Parameter Array from dt.
DAYMONL = dt - WeekDay(dt, Application.Match(dmlWeekDay, vntDay, 0))
End Function
Использование в Excel
US
Для расчета последней субботы октября 2019 года:
=DAYMONL(7,10,2019)
Для расчета последней среды вАпрель 1999 года:
=DAYMONL(4,4,1999)
EU
Чтобы использовать функцию с первым днем недели как Понедельник , необходимовручную 'измените константу FirstDayOfWeek на 2.Затем вы можете использовать следующие формулы для двух предыдущих примеров:
=DAYMONL(6;10;2019)
=DAYMONL(3;4;1999)