Option Explicit
Sub TONGHOP()
Dim Dic As Object, sArr(), sRes(), Res(), i&, iRow&, Key, S, k&
Dim dayNames(7) As String
dayNames(1) = "Ch" & ChrW(7911) & " Nh" & ChrW(7853) & "t"
dayNames(2) = "Th" & ChrW(7913) & " Hai"
dayNames(3) = "Th" & ChrW(7913) & " Ba"
dayNames(4) = "Th" & ChrW(7913) & " T" & ChrW(432)
dayNames(5) = "Th" & ChrW(7913) & " N" & ChrW(259) & "m"
dayNames(6) = "Th" & ChrW(7913) & " S" & ChrW(225) & "u"
dayNames(7) = "Th" & ChrW(7913) & " B" & ChrW(7843) & "y"
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = vbTextCompare
Dic.Add "TM", 4: Dic.Add "CK", 5: Dic.Add "VNPAY", 6: Dic.Add "TH" & ChrW(7866), 7: Dic.Add "VO", 8
With Sheets("Detail")
iRow = .Range("E" & .Rows.Count).End(xlUp).Row
If iRow < 3 Then
MsgBox "Không có du lieu"
Exit Sub
End If
sArr = .Range("A3:S" & iRow).Value
End With
ReDim sRes(1 To UBound(sArr), 1 To 10)
ReDim Res(1 To UBound(sArr), 1 To 12)
For i = 1 To UBound(sArr)
Key = Join(Array(sArr(i, 3), sArr(i, 5), sArr(i, 8), sArr(i, 6)), "|")
If Key <> "|||" Then
Dic(Key) = Dic(Key) + sArr(i, 14)
End If
Next
For Each Key In Dic.keys
S = Split(Key, "|")
If UBound(S) >= 3 Then
k = k + 1
sRes(k, 1) = dayNames(Weekday(CDate(S(1))))
sRes(k, 2) = CDate(S(1))
sRes(k, 3) = S(2)
sRes(k, 4) = "TH"
sRes(k, 6) = Dic(Key)
sRes(k, 9) = S(0)
sRes(k, 10) = sRes(k, 6) + sRes(k, 7)
Res(k, 1) = sRes(k, 1)
Res(k, 2) = sRes(k, 2)
Res(k, 3) = sRes(k, 3)
If Dic.Exists(S(3)) Then
Res(k, Dic(S(3))) = Dic(Key)
End If
Res(k, 10) = S(0)
Res(k, 11) = "TH"
Res(k, 12) = WorksheetFunction.Sum(Res(k, 4), Res(k, 5), Res(k, 6), Res(k, 7), Res(k, 8), -Res(k, 9))
End If
Next
With Sheets("REVENUE DAILY REPORT")
If k Then
.Range("A13").Resize(10000, 10).ClearContents
.Range("A13").Resize(k, 10).Value = sRes
.Range("A13").Resize(k, 10).Sort .Range("B12"), xlAscending
End If
End With
With Sheets("CASH DAILY REPORT")
If k Then
.Range("A14").Resize(10000, 12).ClearContents
.Range("A14").Resize(k, 12).Value = Res
.Range("A14").Resize(k, 12).Sort .Range("B13"), xlAscending
End If
End With
Application.ScreenUpdating = True
MsgBox "Ðã hoàn thành", vbOKOnly, "Thông báo"
End Sub