Sub Tong_()
Dim Nguon, Dong, Cot
Dim Tam
Dim TenNv, KqNv
Dim TenPp, KqPp
Dim Reg As Object
Dim i, j, k, x, t
Nguon = Sheet1.Range("A2").CurrentRegion
Dong = UBound(Nguon)
Cot = UBound(Nguon, 2)
ReDim TenNv(1 To 1, 1 To Cot)
ReDim KqNv(1 To 1, 1 To Cot)
Set Reg = CreateObject("VbScript.RegExp")
Reg.Global = True
Reg.Pattern = "[A-Z]+|\d+"
With CreateObject("Scripting.Dictionary")
For j = 2 To Cot
For i = 3 To Dong
If Nguon(i, j) <> "" Then
Set Tam = Reg.Execute(Nguon(i, j))
For x = 0 To Tam.Count - 1 Step 2
t = Tam(x)
k = CLng(Tam(x + 1))
.Item(t) = .Item(t) + k
KqNv(1, j - 1) = KqNv(1, j - 1) + k
Next x
End If
Next i
TenNv(1, j - 1) = Nguon(2, j)
Next j
TenPp = .keys
KqPp = .items
End With
With Sheet1
.Range("I2").Resize(UBound(TenPp) + 1, 1).ClearContents
.Range("I2").Resize(UBound(TenPp) + 1, 1) = WorksheetFunction.Transpose(TenPp)
.Range("J2").Resize(UBound(KqPp) + 1, 1).ClearContents
.Range("J2").Resize(UBound(KqPp) + 1, 1) = WorksheetFunction.Transpose(KqPp)
.Range("H10").Resize(UBound(TenNv, 2), 1).ClearContents
.Range("H10").Resize(UBound(TenNv, 2), 1) = WorksheetFunction.Transpose(TenNv)
.Range("I10").Resize(UBound(KqNv, 2), 1).ClearContents
.Range("I10").Resize(UBound(KqNv, 2), 1) = WorksheetFunction.Transpose(KqNv)
.UsedRange.Columns.AutoFit
End With
End Sub