VBA实现任务时间按小时拆分求助（跨午夜场景）

核心逻辑 #

• 利用Excel日期时间的数值属性（1代表1天，1/24代表1小时），逐小时推进拆分
• 每次对比当前小时的结束时间与任务的实际结束时间，取较小值作为拆分后的时间段终点
• 循环处理直到当前时间覆盖任务的结束时间

完整VBA代码 #

Sub SplitTasksByHour()
    Dim srcSheet As Worksheet, destSheet As Worksheet
    Dim lastRow As Long, destRow As Long, i As Long
    Dim taskName As String, startTime As Date, endTime As Date
    Dim currentHourStart As Date, currentHourEnd As Date
    
    ' 自定义源表和目标表名称，根据你的实际表格修改
    Set srcSheet = ThisWorkbook.Sheets("Sheet1")
    Set destSheet = ThisWorkbook.Sheets("Sheet2")
    
    ' 清空目标表原有数据（保留表头行）
    destSheet.Range("A2:Z" & destSheet.Cells(destSheet.Rows.Count, "A").End(xlUp).Row).ClearContents
    destRow = 2 ' 目标表从第2行开始写入拆分结果
    
    ' 获取源表最后一行数据的行号
    lastRow = srcSheet.Cells(srcSheet.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历源表中每个任务
    For i = 2 To lastRow
        taskName = srcSheet.Cells(i, "A").Value
        startTime = srcSheet.Cells(i, "B").Value
        endTime = srcSheet.Cells(i, "C").Value
        
        ' 跳过无效任务（开始时间晚于/等于结束时间）
        If startTime >= endTime Then GoTo NextTask
        
        ' 将当前时间对齐到最近的整点开始（例如22:15转为22:00）
        currentHourStart = DateSerial(Year(startTime), Month(startTime), Day(startTime)) + _
                           TimeSerial(Hour(startTime), 0, 0)
        
        ' 处理第一个非整点的时间段（如果任务不是从整点开始）
        If startTime > currentHourStart Then
            currentHourEnd = currentHourStart + TimeSerial(1, 0, 0)
            ' 写入拆分后的第一条记录
            destSheet.Cells(destRow, "A").Value = taskName
            destSheet.Cells(destRow, "B").Value = startTime ' 保留原任务开始时间
            destSheet.Cells(destRow, "C").Value = startTime ' 拆分段的开始时间
            destSheet.Cells(destRow, "D").Value = currentHourEnd ' 拆分段的结束时间
            destRow = destRow + 1
            currentHourStart = currentHourEnd
        End If
        
        ' 循环拆分后续的整小时段
        Do While currentHourStart < endTime
            currentHourEnd = currentHourStart + TimeSerial(1, 0, 0)
            
            ' 如果当前小时段的结束时间超过任务实际结束时间，就用任务结束时间作为终点
            If currentHourEnd > endTime Then
                currentHourEnd = endTime
            End If
            
            ' 写入拆分记录
            destSheet.Cells(destRow, "A").Value = taskName
            destSheet.Cells(destRow, "B").Value = startTime ' 保留原任务开始时间
            destSheet.Cells(destRow, "C").Value = currentHourStart
            destSheet.Cells(destRow, "D").Value = currentHourEnd
            destRow = destRow + 1
            
            ' 推进到下一个小时
            currentHourStart = currentHourEnd
        Loop
        
NextTask:
    Next i
    
    ' 设置目标表时间列的显示格式，按需修改
    destSheet.Range("B:D").NumberFormat = "yyyy-mm-dd hh:mm"
    MsgBox "任务拆分完成！"
End Sub

使用步骤 #

1. 整理源数据：把任务数据放到Sheet1，建议表头为：A列「任务名称」、B列「开始时间」、C列「结束时间」，确保时间列是Excel可识别的日期时间格式（比如2024-05-20 22:30）
2. 准备输出表：新建Sheet2用于存放拆分结果（如果已有，代码会自动清空原有数据）
3. 运行宏：按Alt+F11打开VBA编辑器，右键点击当前工作簿→插入→模块，粘贴上述代码，按F5运行即可

可自定义调整项 #

• 修改srcSheet和destSheet的名称，匹配你的实际表格
• 如果需要复制任务的其他属性（比如任务类型、负责人），在代码中添加srcSheet.Range(srcSheet.Cells(i, "E"), srcSheet.Cells(i, "Z")).Copy destSheet.Cells(destRow, "E")这类语句，对应复制列的范围
• 修改时间列的NumberFormat参数，调整显示格式（比如"mm/dd hh:mm"）

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