Thôi thì có miếng thịt ba chỉ bạn thử dùng xem sao:
Sub Macro1()
lr = Range("A" & Rows.Count).End(xlUp).Row
Range("E2:E" & lr).ClearContents
Application.ScreenUpdating = False
Range("A1").Resize(lr, 5).Copy Range("G1")
Columns("G:K").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortField s.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortField s.Add Key:=Range("J1:J" & lr), SortOn:=xlSortOnValues, Order:=xlDescending
ActiveWorkbook.Worksheets("Sheet1").Sort.SortField s.Add Key:=Range("I1:I" & lr), SortOn:=xlSortOnValues, Order:=xlDescending
ActiveWorkbook.Worksheets("Sheet1").Sort.SortField s.Add Key:=Range("H1:H" & lr), SortOn:=xlSortOnValues, Order:=xlAscending
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("G1:K" & lr)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For i = 2 To lr
Range("K" & i) = i - 1
Next i
Set arr1 = Range("A2").Resize(lr, 5)
Set arr2 = Range("G2").Resize(lr, 5)
For k = 1 To lr - 1
For d = 1 To lr - 1
If arr1(k, 2) Like arr2(d, 2) And arr1(k, 3) = arr2(d, 3) And arr1(k, 4) = arr2(d, 4) Then
arr1(k, 5) = arr2(d, 5)
End If
Next d
Next k
Columns("G:K").Delete
Application.ScreenUpdating = True
End Sub
Chú ý các cột từ G đến K ko đc có dữ liệu