Option Explicit
Sub thongke()
Dim lastRow As Long, r As Long, c As Long, chiso As Long, count As Long, startRow As Long, dieukien As String, dulieu(), kq(), rng As Range, dic As Object
' rng la cac dong co CAU KIEN + SO HIEU bi lap lai. Cac dong thuoc rng se bi DELETE
With ThisWorkbook.Worksheets("ThongKe")
lastRow = .Cells(Rows.count, "A").End(xlUp).Row ' dong cuoi cung co du lieu trong cot A
If lastRow < 10 Then Exit Sub ' neu khong co du lieu thi don do choi
If TypeName(Selection) <> "Range" Then Exit Sub
Set rng = Intersect(Selection.Areas(1), .Range("A10:X" & lastRow))
If rng Is Nothing Then Exit Sub
dulieu = rng.Offset(0, 1 - rng.Column).Resize(, 24).Value ' lay du lieu vao mang dulieu
startRow = rng.Row
Set rng = Nothing
End With
Set dic = CreateObject("Scripting.Dictionary")
ReDim kq(1 To UBound(dulieu, 1), 1 To UBound(dulieu, 2)) ' mang kq cung lam la co so dong bang so dong cua dulieu
For r = 1 To UBound(dulieu, 1) ' duyet tung dong cua mang dulieu
dieukien = dulieu(r, 1) & "#" & dulieu(r, 3) ' CAU KIEN#SO HIEU
If dic.exists(dieukien) Then ' da co CAU KIEN + SO HIEU trong tu dien
If rng Is Nothing Then
Set rng = ThisWorkbook.Worksheets("ThongKe").Rows(r + startRow - 1)
Else
Set rng = Union(rng, ThisWorkbook.Worksheets("ThongKe").Rows(r + startRow - 1)) ' tong cac dong bi lap lai CAU KIEN + SO HIEU
End If
chiso = dic.Item(dieukien) ' CAU KIEN + SH da co trong tu dien, doc ra chi so dong cua SH trong mang kq
For c = 14 To UBound(kq, 2)
If c <> 19 Then kq(chiso, c) = kq(chiso, c) + dulieu(r, c) ' cong don dong hien hanh cua mang dulieu vao dong chiso cua mang kq - khong cong cot S
Next c
Else ' chua co CAU KIEN + SO HIEU trong tu dien, tuc dong co SH moi
count = count + 1 ' tang so luong SO HIEU duy nhat
For c = 1 To UBound(kq, 2) ' sao chep dong hien hanh cua mang dulieu sang dong count cua mang kq
kq(count, c) = dulieu(r, c)
Next c
dic.Add dieukien, count ' them CAU KIEN#SH vao tu dien vi tu cach la KEY va chi so dong cua no trong mang kq voi tu cach la ITEM
End If
Next r
If Not rng Is Nothing Then rng.Delete
ThisWorkbook.Worksheets("ThongKe").Cells(startRow, "A").Resize(count, UBound(kq, 2)).Value = kq
End Sub
