Excel VBA实现按日期区间合并统计通话次数的技术求助

我来帮你搞定这个跨页数据的通话次数统计问题！你的思路方向完全正确，核心就是要精准定位每个Call Date:对应的区间，还要处理带(cont.)的跨页合并统计。下面是完整的可运行方案：

整体思路 #

1. 遍历所有Call Date:的位置，通过FindNext实现循环查找
2. 处理跨页的(cont.)标记，判断是否属于同一个日期，合并统计次数
3. 定位每个日期区间的结束行：要么是下一个Call Date:的前一行，要么是最后一个Location:的行
4. 用COUNTIF统计区间内带冒号的行数（符合你最初的统计逻辑）
5. 将结果按要求格式输出到C列

完整VBA代码 #

Sub CountCallsPerDate()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim callDateRng As Range
    Dim nextCallDateRng As Range
    Dim endRng As Range
    Dim endRow As Long
    Dim currentDate As String
    Dim previousDate As String
    Dim callCount As Long
    Dim outputRow As Long
    
    ' 指定要处理的工作表（这里用当前激活表，也可以改成Sheet1这类明确名称）
    Set ws = ActiveSheet
    outputRow = 1 ' C列开始输出结果的起始行
    
    ' 获取A列最后一行有数据的行号
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 找到第一个Call Date的位置（从最后一行往上找第一个，避免漏过顶部数据）
    Set callDateRng = ws.Range("A:A").Find(What:="Call Date:", After:=ws.Cells(lastRow, "A"), _
                    LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    
    Do While Not callDateRng Is Nothing
        ' 清理当前日期文本，去掉(cont.)标记，方便判断是否是同一个日期
        currentDate = Trim(Replace(callDateRng.Value, "(cont.)", ""))
        
        ' 查找下一个Call Date的位置
        Set nextCallDateRng = ws.Range("A:A").FindNext(callDateRng)
        
        ' 确定当前日期区间的结束行
        If Not nextCallDateRng Is Nothing Then
            ' 有下一个Call Date，结束行是它的前一行
            endRow = nextCallDateRng.Row - 1
        Else
            ' 没有下一个Call Date，找最后一个Location:的行作为结束
            Set endRng = ws.Range("A:A").Find(What:="Location:", After:=ws.Cells(lastRow, "A"), _
                            LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
            endRow = endRng.Row
        End If
        
        ' 统计当前区间内包含冒号的行数（就是你要的通话次数逻辑）
        callCount = Application.WorksheetFunction.CountIf(ws.Range("A" & callDateRng.Row & ":A" & endRow), "*:*")
        
        ' 判断是否需要合并跨页的统计
        If currentDate = previousDate Then
            ' 和上一个日期相同，累加通话次数
            Dim existingCount As Integer
            existingCount = Val(Split(ws.Cells(outputRow - 1, "C").Value, " ")(UBound(Split(ws.Cells(outputRow - 1, "C").Value, " "))))
            ws.Cells(outputRow - 1, "C").Value = currentDate & " " & (existingCount + callCount) & " calls"
        Else
            ' 新的日期，输出新的统计行
            ws.Cells(outputRow, "C").Value = currentDate & " " & callCount & " calls"
            outputRow = outputRow + 1
            previousDate = currentDate
        End If
        
        ' 更新下一次查找的起点，防止无限循环
        Set callDateRng = nextCallDateRng
    Loop
    
    MsgBox "统计完成！结果已输出到C列。"
End Sub

关键细节说明 #

• 循环查找逻辑：用Find和FindNext组合遍历所有Call Date:，确保不会漏过任何一个日期区间
• 跨页合并：通过Replace去掉(cont.)，对比清理后的日期文本，相同的话就累加次数，实现跨页合并
• 区间定位：自动判断每个日期的结束位置，不管是下一个日期的开头还是最后一页的Location:，都能精准覆盖
• 统计逻辑：完全沿用你最初的COUNTIF思路，统计区间内所有带冒号的行数

使用注意事项 #

1. 运行前建议先备份你的数据，避免意外
2. 确保数据里的Call Date:和Location:拼写统一，没有大小写或格式差异
3. 如果你的Call Date:是完全匹配的文本，可以把LookAt:=xlPart改成LookAt:=xlWhole，提高查找准确性

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