MS ACCESS 中的 VBA 调度算法

Question

我想根据给定日期计算一些时间表。像我一样

1. 开始日期
2. 结束日期
3. 工作日，例如，星期一、星期三作为频率

我需要计算 weekly biweekly triweekly monthly quarterly 日期从开始日期和结束日期开始，也通过匹配给定的工作日。

举个例子

Date start = 05/07/2018
Date End = 15/07/2018
Frequency days = Saturday

我需要每周星期六的日期，然后是每两周的星期六日期，直到它到达结束日期。

我在 MS ACCESS VBA 中尝试了 DAYOFWEEK，这有点帮助，但我需要知道完整的解决方案，以便计算时间表。

感谢您的帮助。

谢谢

Answer 1

DateAdd Function 可以做到所有这些。

航空代码：

d = StartDate
Do While d <= EndDate
    Debug.Print d   ' <-- Output date
    Select Case Interval
        Case "biweekly": d = DateAdd("ww", 2, d)
        Case "monthly" : d = DateAdd("m", 1, d)
        ' etc.
    End Select
Loop

Answer 2

对于月份，您应始终添加到原始开始日期，因为这可能是一个月的最后几天之一，因此会抵消月份较少天数之后的月份的日期。所以：

Dim StartDate   As Date
Dim EndDate     As Date
Dim NextDate    As Date
Dim Interval    As Long

StartDate = #1/31/2018#
EndDate = #6/30/2018#

Do
    NextDate = DateAdd("m", Interval, StartDate)
    Interval = Interval + 1
    Debug.Print NextDate
Loop Until NextDate >= EndDate

将返回：

2018-01-31
2018-02-28
2018-03-31
2018-04-30
2018-05-31
2018-06-30

对于从特定工作日开始，找到第一个，然后按上述添加间隔：

Public Function DateNextWeekday( _
  ByVal datDate As Date, _
  Optional ByVal bytWeekday As Byte = vbMonday) _
  As Date

' Returns the date of the next weekday, as spelled in vbXxxxday, following datDate.
' 2000-09-06. Cactus Data ApS.

  ' No special error handling.
  On Error Resume Next

  DateNextWeekday = DateAdd("d", 7 - (Weekday(datDate, bytWeekday) - 1), datDate)

End Function

Answer 3

这也应该可以 - 我已经包含输入框，因此您可以输入开始日期、完成日期、星期几和频率，因为我不知道您希望如何输入；这也会将值存储在 Table2 中，它有一个名为 Dates 的字段/列，然后你可以检索它们（我不知道你想如何检索日期，如果你想存储它们等）.. .我希望这会有所帮助！：

Sub test()

'clear the table2:
CurrentDb.Execute "DELETE * FROM Table2"

Dim DBTest As String
Dim RSTest As DAO.Recordset
Dim i As Long
Dim selectorInitDate, selectorEndDate, DBDate As Date

'Enter Start Date
selectorInitDate = Format(InputBox("Initial Date"), "mm/dd/yyyy")
'Enter Finish Date
selectorEndDate = Format(InputBox("End Date"), "mm/dd/yyyy")
'Enter Day of the Week (example: Saturday)
selectorWeekDay = InputBox("Week Day")
'Enter Frecuency (example: weekly, biweekly, etc)
selectorFreqDays = InputBox("Frecuency Days")

If selectorWeekDay = "Sunday" Then WeekDaySelected = 1
If selectorWeekDay = "Monday" Then WeekDaySelected = 2
If selectorWeekDay = "Tuesday" Then WeekDaySelected = 3
If selectorWeekDay = "Wednesday" Then WeekDaySelected = 4
If selectorWeekDay = "Thursday" Then WeekDaySelected = 5
If selectorWeekDay = "Friday" Then WeekDaySelected = 6
If selectorWeekDay = "Saturday" Then WeekDaySelected = 7

If selectorFreqDays = "weekly" Then Freq = 7
If selectorFreqDays = "biweekly" Then Freq = 14
If selectorFreqDays = "triweekly" Then Freq = 21
If selectorFreqDays = "monthly" Then Freq = 30
If selectorFreqDays = "quarterly" Then Freq = 90


DBDate = Format(selectorInitDate, "mm/dd/yyyy")
Count = 0

Do While DBDate <= selectorEndDate

    If Weekday(DBDate) = WeekDaySelected Then

        DBTest = "INSERT INTO Table2 ([Dates]) " & _
                    " VALUES (" & _
                    "'" & DBDate & "');"

        CurrentDb.Execute DBTest

        DBDate = DBDate + Freq - 1

        Count = Count + 1

    End If

DBDate = DBDate + 1

Loop

'this retrieves in a msgbox the saturdays found between the two dates you specify:

DBTest = "SELECT * FROM Table2"

Set RSTest = CurrentDb.OpenRecordset(DBTest)

If Not RSTest.BOF And Not RSTest.EOF Then

    RSTest.MoveFirst

    Do While (Not RSTest.EOF)

        If Format(RSTest.Fields("Dates").Value, "mm/dd/yyyy") >= selectorInitDate And _
        Format(RSTest.Fields("Dates").Value, "mm/dd/yyyy") <= selectorEndDate Then

            mthString = mthString & RSTest.Fields("Dates") & ", "

        End If

      RSTest.MoveNext

     Loop

   End If

' (remove last comma)
mthString = Left(mthString, Len(mthString) - 2)

MsgBox Count & " " & selectorWeekDay & "(s) Added" & Chr(43) & mthString

'clear the table2:
CurrentDb.Execute "DELETE * FROM Table2"

End Sub

按照您的示例，这应该会告诉您每周两个日期之间有多少个星期六，以及这些日期。

注意：您需要在参考中选择“Microsoft DAO 3.6 对象库”

Answer 4

如果您只想将双周日期以 14 天为增量分组，从某个开始日期（例如一年中的第一周）开始，indate 可以是当前日期或您选择的某个日期，或者您可以只是今天（） .

Function biweeklyDate(indate as date) as Date
biweeklyDate = (DateSerial(2021,1,4)-indate) Mod 14 + inDate
End function