将以下内容添加到 VBA 编辑器中的新模块中...
Public Sub SplitTime()
Dim rngCells As Range, lngRow As Long, lngCol As Long, lngWriteRow As Long, i As Long
Dim objDestSheet As Worksheet, objContainer As Scripting.Dictionary, objBreak As Scripting.Dictionary
Dim strPerson As String, strCode As String, strThisPerson As String, bFound As Boolean
Dim x As Long, arrBreak(), lngContainerRow As Long, lngIndexToZero As Long, lngBreakRow As Long
Dim tmStart, tmEnd, tmBreakStart, tmBreakEnd, tmThisBreakStart, tmThisBreakEnd
Set objContainer = New Scripting.Dictionary
Set objBreak = New Scripting.Dictionary
Set rngCells = Selection
Set objDestSheet = Worksheets("Exploded")
objDestSheet.Cells.Clear
lngWriteRow = 1
With rngCells
' Copy the header to the destination worksheet
rngCells.EntireRow(1).Copy objDestSheet.Range("A1")
' Process each person first and foremost.
' We're going to assume that the data isn't sorted, it's safer.
' Capture the rows where the "container" row exist.
' In another dictionary, capture the "break" rows.
For lngRow = 2 To .Rows.Count
strPerson = .Cells(lngRow, 1)
strCode = UCase(.Cells(lngRow, 2))
If strCode = "CONTAINER" Then
If Not objContainer.Exists(strPerson) Then
objContainer.Add strPerson, lngRow
End If
Else
If Not objBreak.Exists(strPerson) Then
objBreak.Add strPerson, Array(lngRow)
Else
arrBreak = objBreak.Item(strPerson)
ReDim Preserve arrBreak(UBound(arrBreak) + 1)
arrBreak(UBound(arrBreak)) = lngRow
objBreak.Item(strPerson) = arrBreak
End If
End If
Next
' For each person, find the "break" rows and calculate accordingly.
For i = 0 To objContainer.Count - 1
strPerson = objContainer.Keys(i)
lngContainerRow = CLng(objContainer.Item(strPerson))
tmStart = TimeValue(.Cells(lngContainerRow, 3).Text)
tmEnd = TimeValue(.Cells(lngContainerRow, 4).Text)
lngWriteRow = lngWriteRow + 1
objDestSheet.Cells(lngWriteRow, 1) = strPerson
objDestSheet.Cells(lngWriteRow, 2) = "Container"
objDestSheet.Cells(lngWriteRow, 3) = tmStart
arrBreak = objBreak.Item(strPerson)
Do While True
tmBreakStart = ""
bFound = False
' Get the lowest out of the breaks.
For x = 0 To UBound(arrBreak)
lngBreakRow = CLng(arrBreak(x))
If lngBreakRow > 0 Then
bFound = True
tmThisBreakStart = TimeValue(.Cells(lngBreakRow, 3).Text)
tmThisBreakEnd = TimeValue(.Cells(lngBreakRow, 4).Text)
If tmBreakStart = "" Or tmThisBreakStart < tmBreakStart Then
lngIndexToZero = x
tmBreakStart = tmThisBreakStart
tmBreakEnd = tmThisBreakEnd
End If
End If
Next
If bFound Then
' Finish off the current row.
objDestSheet.Cells(lngWriteRow, 4) = tmBreakStart
lngWriteRow = lngWriteRow + 1
' Now write the next row with the breaks in it.
objDestSheet.Cells(lngWriteRow, 1) = strPerson
objDestSheet.Cells(lngWriteRow, 2) = "Break"
objDestSheet.Cells(lngWriteRow, 3) = tmBreakStart
objDestSheet.Cells(lngWriteRow, 4) = tmBreakEnd
lngWriteRow = lngWriteRow + 1
' Now write the next row that will form the gap filler for the container.
objDestSheet.Cells(lngWriteRow, 1) = strPerson
objDestSheet.Cells(lngWriteRow, 2) = "Container"
objDestSheet.Cells(lngWriteRow, 3) = tmBreakEnd
arrBreak(lngIndexToZero) = 0
Else
' We've reached the end for that person.
objDestSheet.Cells(lngWriteRow, 4) = tmEnd
Exit Do
End If
Loop
Next
End With
End Sub
...一些注意事项。
- 不能连续中断。也就是说，您不能从下午 3 点到下午 4 点休息，然后在下午 4 点到下午 5 点之后直接休息。当您考虑时，如果需要，应该将休息时间指定为下午 3 点到下午 5 点，这是没有意义的。如果你有端到端，它就会中断。
- 为确保其正常工作，请务必将时间单元格设置为时间 (
[$-409]h:mm AM/PM;@)
- 数据不需要排序，不管怎样它都会起作用，事实上，您可以在下图中看到我实际上在下方插入了第 1 个人的中断，它仍然会产生正确的结果。李>
- 一个人不能在休息时开始或结束。再一次，我认为这没有任何意义，所以没有迎合它。
我认为你不需要知道其他任何事情。
为此，请在您的书中添加一个名为Exploded 的新工作表，选择整个单元组，然后运行宏。输出将在“Exploded”工作表中。
我希望它对你有用，就像对我一样。如果你的数据集和我期望的一样基本，那么它应该可以了。