excel - 查找并发、重叠、日期范围的数量

Question

我有一个谜题，我多年来一直试图解决，但它完全超出了我的能力范围。

我有一个包含 3 列的电子表格。 A 列是教师 ID 号，B 列是他们的类(class)开始日期，C 列是他们的类(class)结束日期。每个讲师 ID 有多个类(class)。

我基本上是在尝试回答这个问题，这位讲师在任何给定时间教授的最大类(class)数量是多少。
本质上，我需要为每个 ID 号找到最大、并发、重叠日期范围的数量。

问题是，虽然我知道如何找到重叠的日期范围，但我不知道如何 计数 并发类(class)的数量。

例如。
讲师 115 列出了以下日期范围:9/10/13/11/04/13
9/17/13/11/11/13
11/05/13/12/30/13
11/12/13/1/20/14

虽然 11/05/13 类(class)与 9/17/13 类(class)和 11/12/13 类(class)重叠，但它们彼此不重叠......所以这位讲师在任何时候最多只教授 2 门类(class)时间。

有没有办法编写一个函数来为每个 ID 返回最大数量的并发重叠日期范围？

编辑不形成 OP 以从评论中传输详细信息:

我可以从几何上解决这个问题，但我不知道如何在 VBA 函数中做到这一点(我对编程还是很陌生)。如果我要在代码之外解决这个问题，我会为每个 ID 创建一个表，每天创建一个列。然后，我会为每个日期范围创建一行，标记为 1在范围重叠的每一列中。然后我会总结每天的总重叠。然后我会使用一个简单的 MAX 函数来返回最大数量的连续重叠。有没有办法在函数内部执行此操作而无需 Excel 物理绘制这些表？

Answer 1

使用 VBA，假设 A 列包含您的开始日期，B 列包含您的结束日期，并假设您的数据从第 1 行开始并且数据中没有空白行，下面的子代码将执行您在评论中概述的内容:

Sub getMaxConcurrent()

    'get minimum date (startDate)
    Dim startDateRange
    Set startDateRange = Range("A1", Range("A1").End(xlDown))

    Dim startDate As Date
    startDate = WorksheetFunction.Min(startDateRange)

    'get maximum date (endDate)
    Dim endDateRange
    Set endDateRange = Range("B1", Range("B1").End(xlDown))

    Dim endDate As Date
    endDate = WorksheetFunction.Max(endDateRange)

    'get date range (dateInterval)
    Dim dateInterval As Integer
    dateInterval = DateDiff("d", startDate, endDate)

    'Create daily table header
    Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Dim x As Integer
    For x = 0 To dateInterval

        Dim dateVal As Date
        dateVal = DateAdd("d", startDate, x)
        Cells(1, 3 + x).Value = dateVal

    Next

    'Fill in daily table
    Dim y As Integer
    y = 2
    Dim startDateValue As Date
    startDateValue = Cells(y, 1).Value

    Do Until IsEmpty(Cells(y, 1).Value)

        For x = 3 To dateInterval + 3

            If (Cells(y, 1).Value <= Cells(1, x).Value) Then
                If (Cells(y, 2).Value >= Cells(1, x).Value) Then
                    Cells(y, x).Value = 1
                Else
                    Cells(y, x).Value = 0
                End If
            Else
                Cells(y, x).Value = 0
            End If

        Next

        y = y + 1
    Loop

    'sum up each day
    For x = 3 To dateInterval + 3
        Cells(y, x).Value = WorksheetFunction.Sum(Range(Cells(2, x).Address & ":" & Cells(y - 1, x).Address))
    Next

    MsgBox ("Max concurrent courses: " & WorksheetFunction.Max(Range(Cells(y, 3).Address & ":" & Cells(y, x).Address)))

End Sub