Mã:
Public Sub THOP()
Dim Dic As Object, Ws As Worksheet, Arr, dArr(1 To 10000, 1 To 7)
Dim I As Long, J As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
If Ws.Name <> "TH" Then
Arr = Ws.Range("G5:M228").Value2
For I = 1 To UBound(Arr)
Tem = Arr(I, 1) & "#" & Arr(I, 2)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
For J = 1 To 7
dArr(K, J) = Arr(I, J)
Next J
Else
For J = 3 To 7
dArr(Dic.Item(Tem), J) = dArr(Dic.Item(Tem), J) + Arr(I, J)
Next J
End If
Next I
End If
Next Ws
With Sheets("TH")
.Range("A5:G5000").ClearContents
.Range("A5").Resize(K, 7) = dArr
.Range("A5").Resize(K, 7).Sort .Range("A4"), xlAscending, .Range("B4"), , xlAscending
End With
Set Dic = Nothing
End Sub