Алгоритм планирования VBA в MS ACCESS

Question

Я хочу рассчитать некоторые графики на основе данных дат. Как у меня

1. Дата начала
2. Дата окончания
3. Будни, например, понедельник, среда как частота

и мне нужно рассчитать weekly biweekly triweekly monthly quarterly даты с даты начала и окончания, а также путем сопоставления с указанными днями недели.

Для примера

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

и мне нужны еженедельные субботние даты, а затем еженедельные субботние даты, пока они не достигнут конечной даты.

Я пробовал DAYOFWEEK в MS ACCESS VBA, который немного помогает, но мне нужно знать полное решение, чтобы я мог рассчитывать графики.

Ваша помощь приветствуется.

Спасибо

Answer 1

В течение нескольких месяцев вы всегда должны добавлять исходную начальную дату, поскольку это может быть один из последних дней месяца, поэтому это сместит даты месяцев, следующих за месяцем, имеющим меньше дней. Итак:

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 2

Это тоже должно работать - я включил поля ввода, чтобы вы могли ввести дату начала, дату окончания, день недели и частоту, потому что я не знаю, как вы хотите этот ввод; также это будет хранить значения в таблице 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

Следуя вашему примеру, вы должны узнать, сколько у вас субботних дней между двумя датами в неделю, и каковы эти даты.

Примечание: вам нужно выбрать по вашей ссылке «Библиотеку объектов Microsoft DAO 3.6»

Answer 3

Функция DateAdd может сделать все это.

Воздушный код:

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