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)随时类(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