问题
This question adds additional requirements to this question.
This first screen shot shows all the columns and a sample of rows that we are working with. The data will be sorted. The sub will need to match all the data that is shown in Red text:
The code will need to identify these and then merge the two rows, keeping the earliest Start date & time and the latest End date & time, and add the data in the last two columns respectively. In the below example the data values are 0 in the last column. If there was a 5 in the top one and 243 in the second line (of the yellow highlighted area), then column I would show 158 and column J would show 248 for the final values.
Thanks in advance for your assistance.
回答1:
Try this code:
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
来源:https://stackoverflow.com/questions/35561890/merge-rows-sum-one-column-of-values-and-keep-earliest-start-time-and-latest-en