Option Explicit
Sub ThuyTrang()
Dim i&, j&, Lr&, t&, k&
Dim Arr(), KQ(), S
Dim Dic As Object, Key
Dim Ma, Si As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
Lr = .Range("A100000").End(3).Row
Arr = .Range("A3:C" & Lr).Value
ReDim KQ(1 To UBound(Arr), 1 To 6)
For i = 1 To UBound(Arr)
S = Split(Arr(i, 1), ".")
Ma = Mid(Arr(i, 2), 1, 11)
Si = Mid(Arr(i, 2), 13, Len(Arr(i, 2)) - 12)
If Si = "L" Then
k = 3
ElseIf Si = "M" Then
k = 4
ElseIf Si = "S" Then
k = 5
ElseIf Si = "XL" Then
k = 6
End If
Key = S(0) & "#" & Ma
If Not Dic.Exists(Key) Then
t = t + 1: Dic.Add (Key), t
KQ(t, 1) = S(0)
KQ(t, 2) = Ma
KQ(t, k) = Arr(i, 3)
Else
j = Dic.Item(Key)
KQ(j, k) = KQ(j, k) + Arr(i, 3)
End If
Next i
If t then
.Range("E4").Resize(1000, 6).Clearcontents
.Range("E4").Resize(t, 6) = KQ
end if
Set Dic = Nothing
End With
Msgbox " Done"
End Sub
