时间戳

首页 > 解决方案 > 如何列出与一个或多个工作日匹配的时间段内的所有日期

excel - 如何列出与一个或多个工作日匹配的时间段内的所有日期

问题描述

我想列出与指定时间段（开始日期到结束日期）的一个或多个工作日匹配的所有日期。工作日以数值形式列出 (MON=1...FRI=5)，并且可以列出一到五个工作日/数字（例如 3 = WED、12 = MON & TUE、345 = WED & THU & FRI ， ETC）。

代码应将第一个工作日/数字与开始日期进行比较，并将匹配的日期列出到单独的列中，或者跳转到下一个工作日/数字并重复比较。当匹配时，或者如果所有列出的工作日/数字都没有成功循环，则开始日期应更新为下一天，并重复该过程，直到检查整个期间。

我的代码适用于列出的第一个工作日/数字，但我无法让它跳到下一个工作日/数字，即。如果列出的工作日/数字是 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

对于 01/07/19 - 01/11/19 期间以及工作日 MON-FRI (12345)，结果应为 01/07/19、01/08/19、01/09/19、01/10/ 19 日，2019 年 1 月 11 日。到目前为止，结果只是 01/07/19。

添加：

期间开始/结束日期在工作表上手动输入，工作日和其他一些数据通过几个 Vlookup 公式检索。工作日实际上是供应商收货日——我的目的是首先列出一段时间内所有可能的预定收货日，然后检查这些工作日是否属于供应商国家/地区的银行假日。最后一步是检查列出的任何收款日期 + 预定义的运输时间是否会因落入交货国家/地区的银行假日而产生冲突。我尝试添加指向 Excel 工作表图像的链接以进行澄清：

收集时间表

链接图像中列出的日期是运行简单解决方案代码的结果（没有子初始化）。我实际上并不需要 G:H 列中的工作日值和工作日，但我将它们留作澄清。现在列出了所有请求的日期，但顺序基于工作日（即 MON、MON、TUE、TUE 等）。我已经可以通过在工作表或 VBA 中对日期进行排序来使用此解决方案，但是由于这个问题已经困扰了我好几天，我真的很想知道是否有一种方法可以根据我的初始描述（第一个开始日期与第一个工作日、第二个工作日等，直到有匹配或所有工作日都被遍历，然后才跳到行中的下一个开始日期），因此结果将显示为 MON、TUE、周三...周一，周二，周三，

标签： excelvbawhile-loop

解决方案

在此处输入图像描述

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

推荐阅读