excel - 3月/6月/9月/12月的第3个星期三

Question

我试图在 Excel VBA 上构建一个函数来获取 3 月 / 6 月 / 9 月 / 周五的第三个星期三，具体取决于哪个更接近指定日期。假设今天是 6/2/2019，那么它应该返回 6/19/2019，如果是 6/19/2019，它应该返回 9/18/2019，以此类推。但是，代码不起作用。我已附上以下代码供您参考。谢谢！

Function NextIMMDate(ByVal dteFromDate As Date) As Date

    Call getNextIMMDate(dteFromDate)

    dayBool = (Day(dteFromDate) < Day(NextIMMDate))
    monthBool = (Month(dteFromDate) = Month(NextIMMDate))

    If (dayBool And monthBool) Or (Not dayBool And Not monthBool) Or (dayBool And Not monthBool) Then
        Call getNextIMMDate(dteFromDate)
    Else
        useDate = DateSerial(Year(dteFromDate), Month(dteFromDate), 21)
        Call getNextIMMDate(useDate)
    End If

End Function

Sub getNextIMMDate()

    Const lngMONTHS_PER_ROLL As Long = 3
    Const lngDAY As Long = 20

    Dim lngMonth As Long
    Dim NextIMMDate As Date

'    dteFromDate = Range("B13")

    lngMonth = -Int((-Month(dteFromDate) - IIf(Day(dteFromDate) > lngDAY, 1, 0)) _
                    / lngMONTHS_PER_ROLL) * lngMONTHS_PER_ROLL

    NextDate = DateSerial(Year(dteFromDate), lngMonth, lngDAY)

    If Weekday(NextDate) = vbWednesday Then
        lngROLL_DAY = 20
    ElseIf Weekday(NextDate) = vbMonday Then
        lngROLL_DAY = 15
    ElseIf Weekday(NextDate) = vbTuesday Then
        lngROLL_DAY = 21
    ElseIf Weekday(NextDate) = vbThursday Then
        lngROLL_DAY = 19
    ElseIf Weekday(NextDate) = vbFriday Then
        lngROLL_DAY = 18
    ElseIf Weekday(NextDate) = vbSaturday Then
        lngROLL_DAY = 17
    ElseIf Weekday(NextDate) = vbSunday Then
        lngROLL_DAY = 16
    End If

    NextIMMDate = DateSerial(Year(dteFromDate), lngMonth, lngROLL_DAY)

'    Range("B31") = NextIMMDate

End Sub

标签： excelvba

Answer 1

这可能需要一些调整，但我猜它应该让你走上正确的道路。我使用了来自 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