从日期列表中提取日期并根据标准 VBA Access 打开/关闭参数

Question

我想提出一个函数，根据以下日期数组检查特定日期并返回上一个年末日期和上一个月末日期。此外，我还想在第二个日期执行两项额外检查，并根据 (1) 是 Y_Date 确切的月末日期和 (2) 是 Y_Date 确切的年末日期返回 True/False。

这是我到目前为止提出的基本代码，但我想知道是否有更简洁的方法。

DateArray = Array("29/12/2017", "29/06/2018", "31/07/2018", "31/08/2018", "28/09/2018", "31/10/2018", "30/11/2018", "31/12/2018", "31/01/2019", "28/02/2019", "29/03/2019", "30/04/2019", "31/05/2019", "28/06/2019", "31/07/2019", "30/08/2019", "30/09/2019", "31/10/2019", "29/11/2019", "31/12/2019")

L_Date = CDate("11/07/2018")
Y_Date = CDate("10/07/2018")

For Each e In DateArray
    If Month(CDate(e)) = (Month(L_Date) - 1) And Year(CDate(e)) = (Year(L_Date)) Then
        ME_Date = CDate(e)
    ElseIf Month(CDate(e)) = 12 And Month(L_Date) = 1 And Year(CDate(e)) = (Year(L_Date) - 1) Then
        ME_Date = CDate(e)
    Exit For
    End If
Next e

For Each e In DateArray
    If Month(CDate(e)) = 12 And Year(CDate(e)) = (Year(L_Date) - 1) Then
        YE_Date = CDate(e)
    Exit For
    End If
Next e

For Each e In DateArray
    MECheck = False
    YECheck = False
    If StrComp(CDate(e), CDate(Y_Date)) = 0 Then
        MECheck = True
        If Month(CDate(Y_Date)) = 12 Then
            YECheck = True
        End If
        Exit For
    End If
Next e

基本上这个过程（以案例为例）应该像这样工作：

案例：

L_Date = 15/11/2018 和 Y_Date = 14/11/2018 返回以下内容：

• ME_Date = 31/10/2018（上个月结束日期）
• YE_Date = 29/12/2017（上一年的结束日期）
• MECheck = False（因为 Y_Date 不是 2018 年 11 月 30 日）
• YECheck = False（因为 Y_Date 不是 2018 年 12 月 31 日）

感谢您的帮助，非常感谢您提供任何建议。

Answer 1

如果您使用的是 Access（根据您的问题标签），我会强烈建议您将自定义日期存储在表格中，而不是硬编码在数组中。这样一来，更新您的日期就更容易了，而且您还可以根据这些日期生成报告。

关于你的评论

这就是我对手动填充的日期数组进行检查的原因（我不必担心创建一个避免假期/周末的函数）

我认为从长远来看，编写函数来跳过周末和节假日实际上更容易。我会先创建一个表格来存储您的假期。然后编写一个类似下面的函数来检查给定的日期是否是假日：

' this function uses the Holidays table ('tHolidays')
' to see if a provided date is a holiday
' uses DLookup rather than parameterized query for speed
Function IsHoliday(ByVal MyDate As Date) As Boolean
   Dim sFilter As String
   Dim record As Variant

   sFilter = "HolidayDate = #" & MyDate & "#"
   record = DLookup("HolidayDate", "tHolidays", sFilter)
   IsHoliday = Not IsNull(record)
End Function

检查给定日期是否是周末的函数也很简单：

Function IsWeekendDay(ByVal MyDate as Date, _
        optional weekendDay1 as VbDayOfWeek = vbSaturday, _
        optional weekendDay2 as VbDayOfWeek = vbSunday) _
as boolean

    Dim weekday as Integer

    weekday = datepart("w", MyDate)
    IsWeekendDay = (weekday = weekendDay1) Or (weekday = weekendDay2)

End Function

您可以改写代码以添加新函数来确定给定的月末或给定的年末。像这样的：

Function GetYearEnd(pYear as Integer) as Date
    GetYearEnd = DateSerial(Year:=pYear, Month:=12, Day:=31)

    Do Until Not (IsHoliday(GetYearEnd) or IsWeekendDay(GetYearEnd))
        GetYearEnd = GetYearEnd - 1
    Loop
End Function

Function GetMonthEnd(pYear as Integer, pMonth as Integer)
    ' start with the 1st of the month
    GetMonthEnd = DateSerial(Year:=pYear, Month:=pMonth, Day:=1)

    ' the last calendar day of the month is 
    ' 1 less than the first day of the next month
    ' this approach means we won't have to worry about leap years
    GetMonthEnd = DateAdd("m", 1, GetMonthEnd) - 1

    Do Until Not (IsHoliday(GetMonthEnd) Or IsWeekendDay(GetMonthEnd))
        GetMonthEnd = GetMonthEnd - 1
    Loop
End Function

Answer 2

好吧，我必须承认我设计的代码与你的完全不同，因为在 Excel 上处理日期更容易，所以我在 Access 中添加了对 Excel 的引用。

之后，我使用 Excel 中的自然 WorksheetFunctions 设计了 ​​4 个函数来获取每种情况下的自然日期（上一个年末、上一个月末、本月末和本年末）。

Private Function PREV_YEAR_ED(ByVal ThisDate As Date) As Date
PREV_YEAR_ED = CDate("31/12/" & Year(WorksheetFunction.EDate(CDate(ThisDate), -12)))
End Function

Private Function PREV_MONTH_ED(ByVal ThisDate As Date) As Date
PREV_MONTH_ED = CDate(WorksheetFunction.EoMonth(CDate(ThisDate), -1))
End Function

Private Function MONTH_ED(ByVal ThisDate As Date) As Date
MONTH_ED = CDate(WorksheetFunction.EoMonth(CDate(ThisDate), 0))
End Function

Private Function YEAR_ED(ByVal ThisDate As Date) As Date
YEAR_ED = CDate("31/12/" & Year(ThisDate))
End Function

之后，我使用您发布的数据设计了宏。布尔检查很容易得到False 或True 只需一个简单的If。

但是要获取上一个年末日期和上一个月末日期，您需要循环所有日期。从数组中的日期，您需要得到最接近您的数据的日期，并且必须等于或小于您的数据。

因此代码检查日期之间的差异，存储具有日期之间最小差异的数组索引，并返回该值。

Sub MACRO()

Dim DateArray As Variant

Dim L_Date, Y_Date, ME_Date, YE_Date, TargetDate As Date
Dim MECheck, YECheck As Boolean

Dim i As Integer

L_Date = CDate("15/11/2018")
Y_Date = CDate("14/11/2018")

DateArray = Array("29/12/2017", "29/06/2018", "31/07/2018", "31/08/2018", "28/09/2018", "31/10/2018", "30/11/2018", "31/12/2018", "31/01/2019", "28/02/2019", "29/03/2019", "30/04/2019", "31/05/2019", "28/06/2019", "31/07/2019", "30/08/2019", "30/09/2019", "31/10/2019", "29/11/2019", "31/12/2019")

'AVAILABLE FUNCTIONS
'PREV_YEAR_ED will get the natural last day of the previous year, according to the value of ThisDate
'PREV_MONTH_ED will get the natural last day of the previous month, according to the value of ThisDate
'MONTH_ED will get the natural last day of current month, according to the value of ThisDate
'YEAR_ED will get the natural last day of current year, according to the value of ThisDate

'Case L_Date = 15/11/2018 and Y_Date = 14/11/2018 returns the following:
'ME_Date = 31/10/2018 (previous month end date)
'YE_Date = 29/12/2017 (previous year end date)
'MECheck = False (since Y_Date is not the 30/11/2018)
'YECheck = False (since Y_Date is not the 31/12/2018)


Dim DifDays, MinDifDays As Integer
Dim idx As Integer


'to get ME_Date
TargetDate = PREV_MONTH_ED(L_Date)

'ME_DATE will be a date on the array with minimun difference between natural previous month end date (TargetDate)
' and smaller or equal than TargetDate. We need to find with index of the array has the value we want

MinDifDays = 999
For i = 0 To UBound(DateArray) Step 1
    If TargetDate = CDate(DateArray(i)) Then
        idx = i
        Exit For
    ElseIf TargetDate > CDate(DateArray(i)) Then
        DifDays = L_Date - CDate(DateArray(i))
        If DifDays < MinDifDays Then
            MinDifDays = DifDays
            idx = i
        End If
    End If
Next i

ME_Date = CDate(DateArray(idx))

'to get YE_Date
TargetDate = PREV_YEAR_ED(L_Date)

'YE_Date will be a date on the array with minimun difference between natural previous year end date (TargetDate)
' and smaller or equal than TargetDate. We need to find with index of the array has the value we want

MinDifDays = 999
For i = 0 To UBound(DateArray) Step 1
    If TargetDate = CDate(DateArray(i)) Then
        idx = i
        Exit For
    ElseIf TargetDate > CDate(DateArray(i)) Then
        DifDays = L_Date - CDate(DateArray(i))
        If DifDays < MinDifDays Then
            MinDifDays = DifDays
            idx = i
        End If
    End If
Next i

YE_Date = CDate(DateArray(idx))

'boolean checks

If Y_Date = MONTH_ED(Y_Date) Then
    MECheck = True
Else
    MECheck = False
End If

If Y_Date = YEAR_ED(Y_Date) Then
    YECheck = True
Else
    YECheck = False
End If


Debug.Print ME_Date
Debug.Print YE_Date
Debug.Print MECheck
Debug.Print YECheck

Erase DateArray

End Sub
Private Function PREV_YEAR_ED(ByVal ThisDate As Date) As Date
PREV_YEAR_ED = CDate("31/12/" & Year(WorksheetFunction.EDate(CDate(ThisDate), -12)))
End Function

Private Function PREV_MONTH_ED(ByVal ThisDate As Date) As Date
PREV_MONTH_ED = CDate(WorksheetFunction.EoMonth(CDate(ThisDate), -1))
End Function

Private Function MONTH_ED(ByVal ThisDate As Date) As Date
MONTH_ED = CDate(WorksheetFunction.EoMonth(CDate(ThisDate), 0))
End Function

Private Function YEAR_ED(ByVal ThisDate As Date) As Date
YEAR_ED = CDate("31/12/" & Year(ThisDate))
End Function

如果我使用 L_Date = 15/11/2018 和 Y_Date = 14/11/2018 执行此代码，则调试器返回：

很抱歉编写了完全不同的代码，但我希望它可以提供帮助。