VBA实现并发许可水位线统计：时间区间重叠计数问题咨询

现有代码问题定位 #

你遇到的两个问题核心原因如下：

• 循环逻辑错误：你写的For Counter = .Range("I" & FirstRow) To .Range("I" & LastRow)是用I列的时间值作为循环范围，而非按行数循环。当数据按时间升序排列时，刚好循环次数和行数接近能勉强运行，一旦数据乱序，循环次数和行数完全不匹配，就会出现运行中断的问题。
• 区间重叠判断逻辑不完整：两个时间区间重叠的标准判断条件是区间A的开始时间 ≤ 区间B的结束时间 且 区间A的结束时间 ≥ 区间B的开始时间，你当前仅判断了「当前行的开始时间落在对比行的区间内」这一种重叠场景，漏掉了其他重叠情况，导致计数偏少。

修复后可直接运行的代码 #

修复了上述两个问题，同时将变量替换为更安全的Long类型避免溢出，逻辑更清晰：

Private Sub Concurrent2_Click()
    Dim FirstRow As Long, LastRow As Long
    Dim curRow As Long, cmpRow As Long
    Dim overlapCount As Long
    
    ' 可根据实际表结构调整参数
    Const START_COL = "I" ' 开始时间列
    Const END_COL = "J" ' 结束时间列
    Const RESULT_COL = "L" ' 结果输出列
    FirstRow = 2 ' 表头后第一行数据的行号
    
    With Worksheets("Testdaten")
        LastRow = .Cells(.Rows.Count, START_COL).End(xlUp).Row
        
        ' 遍历每一行计算重叠数
        For curRow = FirstRow To LastRow
            overlapCount = 0
            ' 和所有行对比是否重叠
            For cmpRow = FirstRow To LastRow
                ' 标准区间重叠判断，包含边界相等的情况
                If .Cells(curRow, START_COL).Value <= .Cells(cmpRow, END_COL).Value And _
                   .Cells(curRow, END_COL).Value >= .Cells(cmpRow, START_COL).Value Then
                    ' 如果不需要统计自身，可在条件里加 And curRow <> cmpRow
                    overlapCount = overlapCount + 1
                End If
            Next cmpRow
            ' 写入当前行的重叠统计结果
            .Cells(curRow, RESULT_COL).Value = overlapCount
        Next curRow
        
        ' 可选：直接计算水位线（最大重叠数）写入指定单元格，比如M2
        .Range("M2").Value = WorksheetFunction.Max(.Range(RESULT_COL & FirstRow & ":" & RESULT_COL & LastRow))
    End With
End Sub

大数据量优化方案（扫描线算法） #

如果数据量超过1000行，双重循环的O(n²)复杂度效率较低，可以用扫描线算法将时间复杂度降到O(nlogn)，不用逐行对比即可直接算出水位线：

1. 把所有时间点拆成两类事件：开始时间对应+1，结束时间对应-1
2. 所有事件按时间排序，时间相同的话结束事件排在开始事件前面
3. 遍历所有事件累加计数，过程中出现的最大值就是水位线

内容的提问来源于stack exchange，提问作者Ulrich