Объедините строки, суммируйте один столбец значений и сохраните самое раннее время начала и самое последнее время окончания. Часть 2

Question

Этот вопрос добавляет дополнительные требования к этому question.

Этот первый снимок экрана показывает все столбцы и образец строк, с которыми мы работаем. Данные будут отсортированы. Югу должны соответствовать все данные, которые показаны красным цветом текста:

код нужно будет идентифицировать их, а затем объединить эти две строки, сохраняя ранняя дата & время и последняя Конец дата & и добавьте данные в последние два столбца соответственно. В приведенном ниже примере значения данных равны 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