Sub GPE()
Dim Sh As Worksheet, sArr(), Res(), Res2(), S As Variant, Dic As Object
Dim HM As String, Ma As String, SL, Thang As String, DG, tmp, N As Double
Dim sRow As Long, sRow2 As Long, i As Long, iRow As Long
Dim sCol As Long, sCol2 As Long, j As Long, jCol As Long, dCol As Long
Const dk As String = "01ECC" ' Dieu kien xet Sheet ket qua
With Sheets("Tonghop1")
.Range("L7:W2222,Z7:AK2222,AN7:AY2222,BB7:BM2222,BP7:CA2222,CD7:CO2222").ClearContents
dCol = .Range("K6:X6").Columns.Count 'Só cot cua 1 muc danh giá trong bang ket qua ket qua
Res = .Range("K6:CO" & .Range("K" & Rows.Count).End(xlUp).Row).Value 'Mang ket qua Sheets("Tonghop1")
sRow = UBound(Res, 1): sCol = UBound(Res, 2)
End With
Set Dic = CreateObject("scripting.dictionary")
For j = 2 To 13 'Duyet qua các thang
Dic.Add Format(Res(1, j), "mm/yyyy"), j 'Thu tu cot theo thang cua muc danh gia dau tien
Next j
For i = 2 To sRow
Ma = CStr(Res(i, 1))
If Len(Ma) > 0 Then Dic.Add Ma, i 'Add thu tu dòng ket qua Sheets("Tonghop1")
Next i
With Sheets("Tonghop01ECC")
.Range("L7:W2222,Z7:AK2222,AN7:AY2222,BB7:BM2222,BP7:CA2222,CD7:CO2222").ClearContents
Res2 = .Range("K6:CO" & .Range("K" & Rows.Count).End(xlUp).Row).Value 'Mang ket qua Sheets("Tonghop01ECC")
sRow2 = UBound(Res2, 1): sCol2 = UBound(Res2, 2)
End With
For i = 2 To sRow2
Ma = CStr(Res2(i, 1))
If Len(Ma) > 0 Then Dic.Add "#" & Ma & "#", i 'Add thu tu dòng ket qua Sheets("Tonghop01ECC")
Next i
For Each Sh In ActiveWorkbook.Sheets
If Left(Sh.Name, 7) <> "Tonghop" Then
eRow = Sh.Range("U" & Rows.Count).End(xlUp).Row 'Dòng cuoi
If eRow > 4 Then
sArr = Sh.Range("C5:Z" & eRow).Value
For i = 1 To UBound(sArr, 1)
HM = CStr(sArr(i, 1)) 'Hang muc
tmp = sArr(i, 19) 'Ma hang
SL = sArr(i, 20) 'So luong
Thang = CStr(sArr(i, 21)) 'Tháng
DG = sArr(i, 24) 'muc danh giá
If Len(HM) > 0 And Len(tmp) > 0 And Len(SL) > 0 And Len(Thang) > 0 And Len(DG) > 0 Then ' neu có du lieu
If Not IsNumeric(DG) Then DG = 6 'Neu khong phai là so, là muc danh giá thu 6
jCol = Dic.Item(Thang) + (DG - 1) * dCol 'thu tu cot ket qua
S = Split(Replace("&" & tmp, " ", ""), "&") ' mang cac ma hang
N = SL / UBound(S) 'So luong tung ma hang
For j = 1 To UBound(S) 'duyet qua tung ma hang
If HM = dk Then 'ket qua Sheets("Tonghop01ECC")
iRow = Dic.Item("#" & S(j) & "#") 'Thu tu dòng ket qua
If iRow > 0 Then Res2(iRow, jCol) = Res2(iRow, jCol) + N
Else 'ket qua Sheets("Tongho1")
iRow = Dic.Item(S(j)) 'Thu tu dòng ket qua
If iRow > 0 Then Res(iRow, jCol) = Res(iRow, jCol) + N
End If
Next j
End If
Next i
End If
End If
Next Sh
Sheets("Tonghop1").Range("K6").Resize(sRow, sCol) = Res
Sheets("Tonghop01ECC").Range("K6").Resize(sRow2, sCol2) = Res2
End Sub
)
( ...
