Как перечислить все даты в периоде, которые соответствуют одному или нескольким дням недели
Я хочу перечислить все даты, которые соответствуют одному или нескольким дням недели указанного периода (от даты начала до даты окончания). Дни недели указаны в виде числовых значений (ПН=1...ПТ=5), и может быть указано от одного до пяти дней недели/цифр (например, 3 = СР, 12 = ПН и ВТ, 345 = СР, ЧТ и ПТ). , и т.д).
Код должен сравнивать первый день недели/цифру с датой начала и либо указывать совпадающую дату в отдельном столбце, либо переходить к следующему дню недели/цифре и повторять сравнение. При наличии совпадения или если все перечисленные дни недели/цифры были неудачно пройдены, начальная дата должна быть обновлена до следующего дня, и процесс повторяется до тех пор, пока не будет проверен весь период.
Мой код работает для первого дня недели/цифры в списке, но я не могу заставить его перейти к следующему дню недели/цифре, т.е. если указанные дни недели/цифры равны 12345 (с понедельника по пятницу), я получаю только те даты, которые соответствуют первому дню недели/цифре (понедельник). Выбор регистра работает, но требует, чтобы количество дней недели/цифр всегда было одинаковым. Я попытался разместить счетчик, который обновляет даты начала и положение дня недели/цифры, в разные места цикла, но он либо дает результаты только для первого дня недели/цифры, либо приводит к переполнению.
Sub CollectionDaysTrialV02()
Dim PeriodStartDate, PeriodEndDate As Date
Dim CollectionDays As Range
Dim cycle, rw, iLength, iDigit As Integer
PeriodStartDate = Range("b1").Value
PeriodEndDate = Range("b2").Value
Set CollectionDays = Range("d6")
cycle = 0
iDigit = Mid(CollectionDays, cycle + 1, 1)
iLength = Len(CollectionDays.Value)
rw = 2
Do
If Weekday(PeriodStartDate, vbMonday) <> iDigit Then
cycle = cycle + 1
Else
Cells(rw, 6).Value = PeriodStartDate
Cells(rw, 6).NumberFormat = "dd.mm.yyyy"
rw = rw + 1
cycle = cycle + 1
End If
PeriodStartDate = PeriodStartDate + 1
Loop Until PeriodStartDate = PeriodEndDate
End Sub
Sub Init()
Range("B1") = "01/07/19"
Range("B2") = "01/11/19"
Range("D6") = "12345"
End Sub
За период 07.01.19 - 11.01.19 и рабочие дни ПН-ПТ (12345) результат должен быть 07.01.19, 08.01.19, 09.01.19, 10.01. 19, 11.01.19. Пока результат только 07.01.19.
Добавлен:
Дни начала и окончания периода вручную вводятся в рабочий лист, дни недели и некоторые другие данные извлекаются с помощью пары формул Vlookup. Рабочие дни на самом деле являются днями сбора поставщика. Моя цель — сначала перечислить все возможные запланированные дни сбора за определенный период времени, а затем проверить, не приходится ли какой-либо из этих рабочих дней на выходной день в стране поставщика. Последним шагом будет проверка того, не создает ли какой-либо из перечисленных дней сбора + предопределенное время доставки конфликт, выпадающий на выходной день в стране доставки. Я попытался добавить ссылку на изображение листа Excel для пояснения:
Даты, указанные на связанном изображении, являются результатом запуска кода простого решения (без вспомогательной инициализации). На самом деле мне не нужны значения дней недели и дни недели в столбцах G:H, но я оставил их для уточнения. Все запрошенные даты теперь перечислены, но порядок основан на днях недели (т.е. ПН, ПН, ВТ, ВТ и т. д.). Я уже мог работать с этим решением, либо сортируя даты в таблице рабочих листов, либо в VBA, но, поскольку эта проблема заняла меня в течение нескольких дней, я действительно хотел бы знать, есть ли способ пройти через это в соответствии с моим первоначальным описание (первая дата начала по отношению к первому дню недели, второму дню недели и т. д., пока не будет найдено совпадение или все дни недели не будут пройдены, и только затем переход к следующей дате начала в строке), чтобы результат отображался ПН, ВТ, СР...ПН, ВТ, СР, в хронологическом порядке.
Как выглядит CollectionDays? Я отредактировал ваш код, включив в него sub init ;-)
Ответы 2
Sub Init()
Range("B1") = "01/07/19"
Range("B2") = "01/11/19"
Range("D6") = "12345"
Range("F1:E100").ClearContents
End Sub
Sub CollectionDaysTrialV02()
Dim PeriodStartDate As Date
Dim PeriodEndDate As Date
Dim ActualDate As Date
Dim CollectionDays As Range
Dim cycle As Integer
Dim rw As Integer
Dim iLength As Integer
Dim iDigit As Integer
Dim iCt As Integer
PeriodStartDate = Range("b1").Value
PeriodEndDate = Range("b2").Value
Set CollectionDays = Range("d6")
'Clear Result
Range("F1:E10").ClearContents
cycle = 0
iDigit = Mid(CollectionDays, cycle + 1, 1)
iLength = Len(CollectionDays.Value)
rw = 2
For iCt = 1 To iLength
iDigit = Mid(CollectionDays, iCt, 1)
Debug.Print "iDigit: "; iDigit
ActualDate = PeriodStartDate
Do
If Weekday(ActualDate, vbMonday) = iDigit Then
Cells(rw, 6).Value = ActualDate
Cells(rw, 6).NumberFormat = "dd.mm.yyyy"
Cells(rw, 7).Value = iDigit
Cells(rw, 7).Value = iDigit
Cells(rw, 8).Value = ActualDate
Cells(rw, 8).NumberFormat = "dddd"
rw = rw + 1
'cycle = cycle + 1
End If
ActualDate = ActualDate + 1
Loop Until ActualDate = PeriodEndDate + 1
Next iCt
End Sub
Дни начала/окончания периода B1; B2, а также дни сбора D6 поступают через функцию vlookup, поэтому нет необходимости определять их отдельно. С вашим кодом теперь отображаются все запрошенные дни недели в течение периода, хотя и не в хронологическом порядке, а сначала все ПН, затем все ВТ и т. д. Это большой шаг вперед, и поскольку даты отображаются в таблице, я мог бы просто отсортировать их, но Мне было интересно, есть ли способ сделать это через VBA.
Sub Init()
Range("B1") = "01/07/19"
Range("B2") = "01/17/19"
Range("D6") = "1245"
End Sub
Sub CollectionDaysTrialV03()
Dim PeriodStartDate As Date
Dim PeriodEndDate As Date
Dim ActualDate As Date
Dim CollectionDays As Range
Dim cycle As Integer
Dim rw As Integer
Dim iLength As Integer
Dim iDigit As Integer
Dim iCt As Integer
PeriodStartDate = Range("b1").Value
PeriodEndDate = Range("b2").Value
Set CollectionDays = Range("d6")
'Clear Result
Range("F1:E10").ClearContents
cycle = 0
iDigit = Mid(CollectionDays, cycle + 1, 1)
iLength = Len(CollectionDays.Value)
rw = 2
For ActualDate = PeriodStartDate To PeriodEndDate
For iCt = 1 To iLength
iDigit = Mid(CollectionDays, iCt, 1)
Debug.Print "iDigit: "; iDigit
'ActualDate = PeriodStartDate
If Weekday(ActualDate, vbMonday) = iDigit Then
Cells(rw, 6).Value = ActualDate
Cells(rw, 6).NumberFormat = "dd.mm.yyyy"
Cells(rw, 7).Value = iDigit
Cells(rw, 7).Value = iDigit
Cells(rw, 8).Value = ActualDate
Cells(rw, 8).NumberFormat = "dddd"
rw = rw + 1
'cycle = cycle + 1
End If
'ActualDate = ActualDate + 1
'Loop Until ActualDate = PeriodEndDate + 1
Next iCt
Next ActualDate
End Sub
Почему бы вам не обновить свой код с помощью Sub Init, который дает нам все значения, необходимые для тестирования вашего кода? например Диапазон("B1") = "07.01.19" ...