Sub XepNVL()
Dim sArr(), Res(), iKey
Dim i&, k&, ik&, id&, j&, n&, r&, sRow&, sCol&
With Sheets("XUAT 06 12112011")
'gán mang du lieu
sArr = .Range("A3:K" & .Range("A" & Rows.Count).End(xlUp).Row).Value
End With
sRow = UBound(sArr) 'So dong du lieu
sCol = UBound(sArr, 2) 'So cot du lieu
With CreateObject("scripting.dictionary")
For i = 1 To sRow
iKey = sArr(i, 5)
If Len(iKey) Then
'Dem so dong ket qua, moi loai vat tu them 1 dong tong cong (k=k+2)
If .exists(iKey) = False Then k = k + 2 Else k = k + 1
.Item(iKey) = .Item(iKey) & "," & i 'gán các thu tu dong cua mot loai vat tu vào Item
End If
Next i
ReDim Res(1 To k, 1 To sCol)
k = 0
For Each iKey In .keys
k = k + 1 ' dong tong cong
id = k ' dong tong cong
s = Split(.Item(iKey), ",")
n = UBound(s)
For r = 1 To n
k = k + 1 ' dong du lieu ket qua
ik = CLng(s(r)) ' thu tu dong cua mang sArr
For j = 1 To sCol
Res(k, j) = sArr(ik, j)
Next j
Res(id, 7) = Res(id, 7) + sArr(ik, 7) ' tính dong tong cong cot So_Luong
Res(id, 9) = Res(id, 9) + sArr(ik, 9) ' tính dong tong cong cot Tien
Next r
Next
End With
With Sheets("Kq")
i = .Range("G" & Rows.Count).End(xlUp).Row
If i > 2 Then .Range("A3:K" & i).ClearContents
.Range("A3").Resize(k, sCol) = Res
End With
End Sub