合并行，将一列值相加，并保持最早的开始时间和最晚的结束时间 - 第2部分

Question

此问题为此question添加了其他要求。

第一个屏幕截图显示了我们正在使用的所有列和行样本。数据将被排序。子将需要匹配红色文本中显示的所有数据：

代码需要识别这些，然后合并两行，保持最早的开始日期和时间。时间和最新结束日期＆amp;时间，并分别在最后两列中添加数据。在下面的示例中，最后一列中的数据值为0。如果在顶部一行中有5，在第二行中有243（黄色突出显示的区域），那么第I列将显示158，而第J列将显示最终值为248。

提前感谢您的协助。

Answer 1

试试这段代码：

Sub Test2()

  Dim Rng As Range, dRng As Range
  Dim i As Long, LR As Long 'lastrow

    With Application
     .ScreenUpdating = False
     .EnableEvents = False
     .Calculation = xlCalculationManual
    End With

    LR = Range("A" & Rows.Count).End(xlUp).Row
    Set Rng = Range("A2:J2")

    For i = 3 To LR
     If Rng(1) = Cells(i, 1) And Rng(2) = Cells(i, 2) And Rng(3) = Cells(i, 3) _
        And Rng(4) = Cells(i, 4) And Rng(5) = Cells(i, 5) And Rng(6) = Cells(i, 6) Then

      Set Rng = Range(Rng(1), Cells(i, 10))

     Else
      If Rng.Rows.Count > 1 Then GoSub mSub
      Set Rng = Range(Cells(i, 1), Cells(i, 10))
     End If
    Next

    If Rng.Rows.Count > 1 Then GoSub mSub
    If Not dRng Is Nothing Then dRng.EntireRow.Delete

    With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
    End With

  Exit Sub

mSub:

    With WorksheetFunction
     Rng(7) = .Min(Rng.Columns(7))
     Rng(8) = .Max(Rng.Columns(8))
     Rng(9) = .Sum(Rng.Columns(9))
     Rng(10) = .Sum(Rng.Columns(10))
    End With

    If dRng Is Nothing Then
     Set dRng = Range(Rng(2, 1), Rng(Rng.Count))
    Else
     Set dRng = Union(dRng, Range(Rng(2, 1), Rng(Rng.Count)))
    End If

  Return
End Sub