Это может потребовать доработки, но это должно помочь вам выбрать правильный путь. Я использовал функцию от vbaexpress.com, которая, честно говоря, выполняет большую часть работы. Моя часть касается только вашей логики.
Public Function NextIMMDate(ByVal dteFromDate As Date) As Date
Const nthPosition As Long = 3 'Third week
Const dayIndex As Long = 4 'Wednesday
Dim targetYear As Long
Dim X As Long
Dim arrMonths(1 To 4) As Long: For X = 1 To 4: arrMonths(X) = X * 3: Next X
Dim arrDates(1 To 4) As Date
targetYear = Year(dteFromDate)
For X = LBound(arrMonths) To UBound(arrMonths)
If X = UBound(arrMonths) Then
'handle next year?
arrDates(X) = NthWeekday(nthPosition, dayIndex, 3, targetYear + 1)
Else
arrDates(X) = NthWeekday(nthPosition, dayIndex, arrMonths(X), targetYear)
End If
If arrDates(X) > dteFromDate Then
NextIMMDate = arrDates(X)
Exit For
End If
Next X
End Function
Public Function NthWeekday(Position, dayIndex As Long, targetMonth As Long, Optional targetYear As Long)
'Source: http://www.vbaexpress.com/kb/getarticle.php?kb_id=814
'****************************************************************
' Returns any arbitrary weekday (the "Nth" weekday) of a given month
' Position is the weekday's position in the month. Must be a number 1-5, or the letter L (last)
' DayIndex is weekday: 1=Sunday, 2=Monday, ..., 7=Saturday
' TargetMonth is the month the date is in: 1=Jan, 2=Feb, ..., 12=Dec
' If TargetYear is omitted, year for current system date/time is used
' This function as written supports Excel. To support Access, replace instances of
' CVErr(xlErrValue) with Null. To use with other VBA-supported applications or with VB,
' substitute a similar value
Dim FirstDate As Date
' Validate DayIndex
If dayIndex < 1 Or dayIndex > 7 Then
NthWeekday = CVErr(xlErrValue)
Exit Function
End If
If targetYear = 0 Then targetYear = Year(Now)
Select Case Position
'Validate Position
Case 1, 2, 3, 4, 5, "L", "l"
' Determine date for first of month
FirstDate = DateSerial(targetYear, targetMonth, 1)
' Find first instance of our targeted weekday in the month
If Weekday(FirstDate, vbSunday) < dayIndex Then
FirstDate = FirstDate + (dayIndex - Weekday(FirstDate, vbSunday))
ElseIf Weekday(FirstDate, vbSunday) > dayIndex Then
FirstDate = FirstDate + (dayIndex + 7 - Weekday(FirstDate, vbSunday))
End If
' Find the Nth instance. If Position is not numeric, then it must be "L" for last.
' In that case, loop to find last instance of the month (could be the 4th or the 5th)
If IsNumeric(Position) Then
NthWeekday = FirstDate + (Position - 1) * 7
If Month(NthWeekday) <> Month(FirstDate) Then NthWeekday = CVErr(xlErrValue)
Else
NthWeekday = FirstDate
Do Until Month(NthWeekday) <> Month(NthWeekday + 7)
NthWeekday = NthWeekday + 7
Loop
End If
' This only comes into play if the user supplied an invalid Position argument
Case Else
NthWeekday = CVErr(xlErrValue)
End Select
End Function