连续计算多个日期范围内的唯一日期

Question

我有一个 excel 电子表格，在不同的列中有多个开始日期和结束日期。我需要计算这些日期范围内的唯一天数。

我的问题的所有 "solutions" 我发现所有开始日期都在一列中，所有结束日期都在另一列中。我把所有数据都排成一行。

示例：

E23 中的开始日期 1。值 = 2019-01-01
F23 中的结束日期 1。值 = 2019-01-03
I23 中的开始日期 2。值 = 2019-02-01
J23 中的结束日期 2。值 = 2019-02-03
M23 中的开始日期 3。值 = 2019-01-02
N23 中的结束日期 3。值 = 2019-01-03
(...多列继续这样)

我在上面的例子中寻找的总和是 6，因为 start/end 日期 3 应该包含在 start/end 日期 1 中。

一旦我解决了这个问题，我只需要包含某一年内的结果。我稍后再处理。

编辑。我将下面的解决方案修改为当前代码：

Function UniqueDayCount(rYear As Date, rCol As Integer) As Long

    Dim ws As Worksheet
    Dim rAllDates As Range
    Dim rDateGroup As Range
    Dim hUnqDates As Object
    Dim dtStart As Date
    Dim dtEnd As Date
    Dim dtTemp As Date

    Set ws = ActiveWorkbook.ActiveSheet
    Set rAllDates = Intersect(ws.Rows(rCol), ws.Range("E:F,I:J,M:N,Q:R,U:V,Y:Z,AC:AD,AG:AH,AK:AL,AO:AP,AS:AT,AW:AX,BA:BB,BE:BF"))
    Set hUnqDates = CreateObject("Scripting.Dictionary")

    For Each rDateGroup In rAllDates.Areas
        dtStart = Int(rDateGroup.Cells(1, 1).Value2)
        dtEnd = Int(rDateGroup.Cells(rDateGroup.Rows.Count, rDateGroup.Columns.Count).Value2)
        For dtTemp = dtStart To dtEnd
            If Year(dtTemp) = rYear Then
                If Not hUnqDates.Exists(dtTemp) Then hUnqDates.Add dtTemp, dtTemp
            End If
        Next dtTemp
    Next rDateGroup

    UniqueDayCount = hUnqDates.Count

End Function

我使用以下公式调用它：=UniqueDayCount(2019, ROW())

Answer 1

像这样的东西应该适合你：

Sub tgr()

    Dim ws As Worksheet
    Dim rAllDates As Range
    Dim rDateGroup As Range
    Dim hUnqDates As Object
    Dim dtStart As Date
    Dim dtEnd As Date
    Dim dtTemp As Date

    Set ws = ActiveWorkbook.ActiveSheet
    Set rAllDates = Intersect(ws.Rows(23), ws.Range("E:F,I:J,M:N"))
    Set hUnqDates = CreateObject("Scripting.Dictionary")

    For Each rDateGroup In rAllDates.Areas
        dtStart = Int(rDateGroup.Cells(1, 1).Value2)
        dtEnd = Int(rDateGroup.Cells(rDateGroup.Rows.Count, rDateGroup.Columns.Count).Value2)
        For dtTemp = dtStart To dtEnd
            If Year(dtTemp) = 2019 Then
                If Not hUnqDates.Exists(dtTemp) Then hUnqDates.Add dtTemp, dtTemp
            End If
        Next dtTemp
    Next rDateGroup

    MsgBox hUnqDates.Count

End Sub

将其用作工作表函数：

Function UniqueDayCount(ByVal arg_lYear As Long, ByVal arg_lRow As Long) As Long

    Dim ws As Worksheet
    Dim rAllDates As Range
    Dim rDateGroup As Range
    Dim hUnqDates As Object
    Dim dtStart As Date
    Dim dtEnd As Date
    Dim dtTemp As Date

    Set ws = ActiveWorkbook.ActiveSheet
    Set rAllDates = Intersect(ws.Rows(arg_lRow), ws.Range("E:F,I:J,M:N,Q:R,U:V,Y:Z,AC:AD,AG:AH,AK:AL,AO:AP,AS:AT,AW:AX,BA:BB,BE:BF"))
    Set hUnqDates = CreateObject("Scripting.Dictionary")

    For Each rDateGroup In rAllDates.Areas
        If IsNumeric(Int(rDateGroup.Cells(1, 1).Value2)) _
        And IsNumeric(Int(rDateGroup.Cells(rDateGroup.Rows.Count, rDateGroup.Columns.Count).Value2)) Then
            dtStart = Int(rDateGroup.Cells(1, 1).Value2)
            dtEnd = Int(rDateGroup.Cells(rDateGroup.Rows.Count, rDateGroup.Columns.Count).Value2)
            For dtTemp = dtStart To dtEnd
                If Year(dtTemp) = arg_lYear Then
                    If Not hUnqDates.Exists(dtTemp) Then hUnqDates.Add dtTemp, dtTemp
                End If
            Next dtTemp
        End If
    Next rDateGroup

    UniqueDayCount = hUnqDates.Count

End Function

连续计算多个日期范围内的唯一日期

Counting unique dates in multiple date ranges in a row

excel

vba

date

count

formula