vb.net 新年第4个星期二

Question

I have written a Check Book application that stores the 4th Tuesday of the month in a SQLite Database and when the user writes a check and the Date Today is greater than the stored date a NEW 4th Tuesday date is updated in the DB and a function to deposit the SS Payment is loaded.
While testing I discovered that when the Year changes the first Function I wrote would fail.
So I have written a second Function to deal with the the change in Years.
The code seems to be working. I would like to combine the test into one Function as the code seems less than elegant. I will post the small TEST application code below. The Two Functions are in a Module.

Public Class frmStart
Dim varSearchDate As Date
Dim varFTue As Date

Private Sub frmStart_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    tbBox1.Text = "2021-12-28" ' 2021-11-23 2021-12-28 TEST DATES
End Sub

Private Sub btnADD_Click(sender As Object, e As EventArgs) Handles btnADD.Click
    varSearchDate = CDate(tbBox1.Text)
    tbAns.Text = varSearchDate.ToString("M-d-yyyy")

    Dim dateToday = Date.Today
    Dim mo As String
    mo = varSearchDate.ToString("MM")

    If dateToday > varSearchDate And CInt(mo) <> 12 Then
        varFTue = CDate(FourthTueOfNextMonth(Date.Today).ToString("yyyy-M-d"))
        MsgBox("varFTue Next Mo " & varFTue)
        tbBox2.Text = varFTue.ToString("yyyy-M-d")
        'WriteNewFourthTue()
        'gvTxType = "SS Deposit"
    ElseIf dateToday > varSearchDate And CInt(mo) = 12 Then
        varFTue = CDate(FourthTueOfNewYear(Date.Today).ToString("yyyy-M-d"))
        MsgBox("varFTue New Yr " & varFTue)
        tbBox3.Text = varFTue.ToString("yyyy-M-d")
        'WriteNewFourthTue()
        'gvTxType = "SS Deposit"
    End If
End Sub

End Class

The two function and my TEST code to use ONLY ONE FUNCTION commented out

Module FunctionModule

'Function FourthTueOfNextMonth(dt As Date) As Date
'    Dim currDate = New Date(dt.Year, dt.Month, 1)
'    Dim nTuesday As Integer
'    While nTuesday < 4
'        If currDate.DayOfWeek = DayOfWeek.Tuesday Then
'            nTuesday += 1
'        End If
'        currDate = currDate.AddDays(1)
'    End While
'    If dt.Month <> 12 Then
'        Return New Date(dt.Year, dt.Month, currDate.Day - 1)
'    ElseIf dt.Month = 12 Then
'        Return New Date(dt.Year + 1, dt.Month - 11, currDate.Day - 1)
'    End If
'End Function

Function FourthTueOfNextMonth(dt As Date) As Date
    Dim currDate = New Date(dt.Year, dt.Month, 1)
    Dim nTuesday As Integer

    While nTuesday < 4
        If currDate.DayOfWeek = DayOfWeek.Tuesday Then
            nTuesday += 1
        End If
        currDate = currDate.AddDays(1)
    End While

    Return New Date(dt.Year, dt.Month, currDate.Day - 1)

End Function

Function FourthTueOfNewYear(dt As Date) As Date
    Dim currDate = New Date(dt.Year + 1, dt.Month - 11, 1)
    Dim nTuesday As Integer

    While nTuesday < 4
        If currDate.DayOfWeek = DayOfWeek.Tuesday Then
            nTuesday += 1
        End If
        currDate = currDate.AddDays(1)
    End While

    Return New Date(dt.Year + 1, dt.Month - 11, currDate.Day - 1)

End Function

End Module

My Question is there a better way to write this code so I only have one Function?

Answer 1

Here's a function that finds the Fourth Tuesday of the NEXT Month, based on the Date passed in:

Function FourthTueOfNextMonth(dt As Date) As Date
    ' Start with the First Day of the Month, from the date passed in.
    ' Add one Month to that to get the first Day of the NEXT month.
    Dim currDate As Date = (New Date(dt.Year, dt.Month, 1)).AddMonths(1)
    ' Find the First Tuesday of the Month
    While currDate.DayOfWeek <> DayOfWeek.Tuesday
        currDate = currDate.AddDays(1)
    End While
    ' Add three more Weeks to jump to Fourth Tuesday
    Return currDate.AddDays(21)
End Function

Note that the function always returns the fourth Tuesday of the NEXT month, and that it doesn't check to see if the date passed in is less than the Fourth Tuesday of the same month containing the date passed in.