MS-ACCESS中的VBA调度算法

我想根据给定的日期计算一些日程安排。像我一样

开始日期

结束日期

工作日，例如，周一、周三作为频率

我需要计算一下

每周的
双周
三周
月刊
每季的

从开始日期到结束日期，以及通过匹配给定的工作日

例如

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

我需要每周周六的约会，然后每两周周六的约会，直到结束日期

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

谢谢你的帮助

谢谢

我能做到这一切

航空代码：

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

d=起始日期
当d持续数月时，您应始终将起始日期添加到原始起始日期，因为这可能是一个月的最后几天之一，因此将抵消天数较少的月份之后的几个月的日期。因此：

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

这也应该起作用-我已经包括了输入框，所以你们可以输入开始日期、完成日期、一周中的哪一天和频率，因为我不知道你们想要怎样的输入；此外，这将把值存储在表2中，表中有一个名为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

子测试（）
“清除表格2：
CurrentDb.执行“从表2中删除*”
Dim DBTest作为字符串
作为DAO.Recordset进行测试
我想我会坚持多久
Dim SELECTORINITATE、selectorEndDate、DBDate作为日期
'输入开始日期
selectorInitDate=格式（输入框（“初始日期”），“mm/dd/yyyy”）
'输入完成日期
选择OrEndDate=格式（输入框（“结束日期”），“mm/dd/yyyy”）
'输入星期几（例如：星期六）
选择或工作日=输入框（“工作日”）
'输入频率（例如：每周、每两周等）
selectorFreqDays=InputBox（“频率日”）
如果选择或Weekday=“Sunday”，则Weekday selected=1
如果选择OrWeekday=“Monday”，则选择Weekday=2
如果选择或Weekday=“星期二”，则Weekday selected=3
如果选择或Weekday=“星期三”，则Weekday selected=4
如果选择或Weekday=“星期四”，则Weekday selected=5
如果选择orWeekday=“Friday”，则选择Weekday=6
如果选择OrWeekday=“Saturday”，则选择Weekday=7
如果选择orfreqdays=“weekly”，则Freq=7
如果选择FreqDays=“双周”，则Freq=14
如果选择orfreqdays=“三周”，则Freq=21
如果选择orfreqdays=“monthly”，则Freq=30
如果选择OrFreqDays=“quarterly”，则Freq=90
DBDate=格式（选择日期“mm/dd/yyyy”）
计数=0
当您在寻找
DateAdd
函数时，请执行DBDate命令。@Andre您知道的越多<实际上，code>DateAdd
似乎相当强大。还有，这不是一个完整的答案吗？我想你是对的@谢谢。DateAdd看起来很有希望。但我如何才能在两周后得到具体日期，例如星期五。例如，2周、3周、4周后的星期五是什么日期etc@Aziz，我附加了一个函数来查找工作日的日期。谢谢。只有2条评论1。如果我们有多个工作日，如星期五至星期六，由管道标志2隔开，该怎么办。如何选择引用“Microsoft DAO 3.6对象库”我正在使用MS Access 2016.1。可以从带有管道符号的字符串中提取“星期五”和“星期六”，然后运行宏；2.在visual basic编辑器中，您必须选择工具>引用…>Microsoft DAO 3.6对象库-：）非常感谢。您的解决方案非常有效。有一个问题。假设我选择了本周的星期六，并希望获得下一周的星期一日期。你知道下周一天后就要开始了。但是在你的解决方案中，你添加了7，14，21等等。它将日期带到了未来，我们无法得到过去的那一周的特定日期。我希望您理解我想说的。它在第一次查找后添加了7、14等，因此如果您输入2018年7月7日（星期六）并选择星期一，它将检索下周一（2018年7月9日）。是的，这是错误的。它应该在星期一检索当前星期。