3ème mer de mars / juin / sept / déc.

Cela pourrait avoir besoin de peaufiner, mais cela devrait vous mettre sur le bon chemin, je suppose. J'ai utilisé une fonction de vbaexpress.com, qui fait la majeure partie du travail pour être honnête. Ma partie ne manipule que votre logique.

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

Construisez une gamme de «troisièmes quarts de mercredi» et utilisez la fonction de match de la feuille de travail pour trouver la fonction appropriée de la date de saisie.

Option Explicit

Function NextThirdWednesdayQuarter(dt As Long)

    Dim i As Long, m As Long, y As Long
    ReDim dts(0) As Variant

    'building the 'third Wednesday' doesn't take long
    'you should never need more than Mar, Jun, Sep, Dec for
    'the current year and the next year of input date
    'descending order for the worksheet match function
    For y = Year(dt) + 1 To Year(dt) Step -1
        'for Mar, Jun, Sep, Dec
        For m = 12 To 3 Step -3
            'third Wednesday in m and y
            dts(UBound(dts)) = CLng(DateSerial(y, m, 22 - Weekday(DateSerial(y, m, 0), vbWednesday)))
            'make room for next
            ReDim Preserve dts(UBound(dts) + 1)
        Next m
    Next y

    'remove last unused array element
    ReDim Preserve dts(UBound(dts) - 1)

    'add noon to input date so equals won't match
    'worksheet's Match in descending order gives position of date from array
    NextThirdWednesdayQuarter = dts(Application.Match(dt + 0.5, dts, -1) - 1)

    'don't forget to format the UDF worksheet cell as a date

End Function

Vous pouvez le faire avec une formule de la feuille de calcul:

+21-WEEKDAY(EDATE(A1-DAY(A1)+1,2-MOD(MONTH(A1)-1,3))+3)