Sub tonghop()
Dim a As Long, lr As Long, i As Long, b As Long
Dim arr, arr1(1 To 1000, 1 To 4), dic As Object
Dim sh As Worksheet
Set dic = CreateObject("scripting.dictionary")
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "Tong hop" Then
lr = sh.Range("A" & Rows.Count).End(xlUp).Row
If lr > 4 Then
arr = sh.Range("A5:C" & lr).Value
For i = 1 To UBound(arr, 1)
If Not dic.exists(arr(i, 1)) Then
a = a + 1
arr1(a, 1) = arr(i, 1)
arr1(a, 2) = arr(i, 2)
If arr(i, 3) = "A" Then
arr1(a, 3) = 1
ElseIf arr(i, 3) = "B" Then
arr1(a, 4) = 1
End If
dic.Add arr(i, 1), a
Else
b = dic.Item(arr(i, 1))
If arr(i, 3) = "A" Then
arr1(b, 3) = 1 + arr1(b, 3)
ElseIf arr(i, 3) = "B" Then
arr1(b, 4) = 1 + arr1(b, 4)
End If
End If
Next i
End If
End If
Next
With Sheets("tong hop")
lr = .Range("A" & Rows.Count).End(xlUp).Row
If lr > 1 Then .Range("A2:D" & lr).ClearContents
If a Then .Range("A2").Resize(a, 4).Value = arr1
End With
End Sub
