Как составить список всех дат в периоде, который соответствует одному или нескольким рабочим дням - PullRequest
0 голосов
/ 25 января 2019

Я хочу перечислить все даты, которые соответствуют одному или нескольким рабочим дням указанного периода (с даты начала до даты окончания). Рабочие дни указаны в виде числовых значений (MON = 1 ... FRI = 5), и в списке может быть от одного до пяти рабочих дней / цифр (например, 3 = WED, 12 = MON & TUE, 345 = WED & THU & FRI , так далее).

Код должен сравнивать первый день недели / цифру с датой начала и либо перечислять соответствующую дату в отдельном столбце, либо переходить к следующему дню / цифре недели и повторять сравнение. В случае совпадения или если все перечисленные рабочие дни / цифры были неудачно циклически повторены, дата начала должна быть обновлена ​​до следующего дня, и процесс повторяется до тех пор, пока не будет проверен весь период.

Мой код работает с первым указанным днем ​​недели / цифрой, но я не могу заставить его перейти на следующий день недели / цифру, т.е. если в списке указаны дни недели / цифры 12345 (с понедельника по пятницу), я получаю только те даты, которые соответствуют первому дню / цифре в день недели (MON). Выбор регистра работает, но требует, чтобы количество дней недели / цифр всегда было одинаковым. Я попытался поместить счетчик, который обновляет даты начала и положение дня недели / цифры, в разные места цикла, но он либо дает результаты только для первого дня недели / цифры, либо приводит к переполнению.

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

За период с 01/07/19 по 01/11/19 и по рабочим дням с понедельника по пятницу (12345) результат должен быть 01/07/19, 01/08/19, 01/09/19, 01 / 10/19, 01/11/19. Пока результат только 01/07/19.

Добавлено:

Дни начала / окончания периода вводятся вручную в таблицу, дни недели и некоторые другие данные извлекаются с помощью нескольких формул Vlookup. Будние дни на самом деле являются днями сбора поставщиков - моя цель - сначала перечислить все возможные запланированные дни сбора для определенного периода времени, а затем проверить, выпадает ли какой-либо из этих рабочих дней в праздничные дни в стране поставщика. Последним шагом будет проверка того, не создает ли конфликт какой-либо из перечисленных дней сбора + предопределенное время транзита, выпадая на выходной день в стране доставки. Я попытался добавить ссылку на изображение листа Excel для уточнения:

CollectionSchedule

Даты, указанные на связанном изображении, являются результатом выполнения кода simple-solution (без sub init). На самом деле мне не нужны значения дней недели и дней недели в столбцах G: H, но я оставил их для пояснения. Все запрошенные даты теперь перечислены, но порядок основан на днях недели (т. Е. MON, MON, TUE, TUE и т. Д.). Я уже мог работать с этим решением, либо сортируя даты в таблице рабочего листа, либо в VBA, но, поскольку эта проблема занимала меня в течение нескольких дней, я действительно хотел бы знать, есть ли способ обойти это в соответствии с моим начальным описание (первая дата начала относительно первого дня недели, второго дня недели и т. д., пока не будет совпадения или пока все циклы недели не пройдут циклично, и только затем переход к следующей дате начала в строке), так что результат будет отображаться MON, TUE, СР ... Пн, Вт, СР, в хронологическом порядке.

Ответы [ 2 ]

0 голосов
/ 30 января 2019

enter image description here

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
0 голосов
/ 25 января 2019

enter image description here

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...