Sub GPE()
Dim i As Long, ik As Long, d As Long, sRow As Long
Dim sArr(), tArr(), Res(), dic As Object, iKey As String
Dim eDate As Long, fDate As Long, Ngay As Long
Set dic = CreateObject("Scripting.dictionary")
With Sheets("NhapLieu")
i = .Range("B" & Rows.Count).End(xlUp).Row
If i < 3 Then MsgBox "khong co du lieu": Exit Sub
sArr = .Range("B3:I" & i).Value
End With
With Sheets("THTien")
fDate = CLng(.Range("D7").Value)
eDate = CLng(.Range("G7").Value)
tArr = .Range("B11:E" & .Range("B" & Rows.Count).End(xlUp).Row + 1).Value
sRow = UBound(tArr)
End With
ReDim Res(1 To sRow + 1, 1 To 5)
For i = 1 To sRow - 1
iKey = tArr(i, 1)
If Len(iKey) > 0 Then
dic.Add iKey, i
Res(i, 1) = tArr(i, 4): Res(i, 2) = tArr(i, 4): Res(i, 5) = tArr(i, 4)
End If
Next i
For i = 1 To UBound(sArr)
ik = dic.Item(sArr(i, 8))
If ik > 0 Then
If IsDate(sArr(i, 1)) Then
Ngay = CLng(sArr(i, 1))
If Len(sArr(i, 2)) > 0 Then d = 1 Else d = -1
If Ngay < fDate Then
Res(ik, 2) = Res(ik, 2) + sArr(i, 7) * d
Res(ik, 5) = Res(ik, 5) + sArr(i, 7) * d
ElseIf Ngay <= eDate Then
Res(ik, 5) = Res(ik, 5) + sArr(i, 7) * d
Res(ik, (7 - d) / 2) = Res(ik, (7 - d) / 2) + sArr(i, 7)
End If
End If
End If
Next i
For i = sRow To 1 Step -1
If Len(tArr(i, 1)) = 0 Then
ik = i
Else
For d = 1 To 5
If Len(Res(i, d)) > 0 Then
Res(ik, d) = Res(ik, d) + Res(i, d)
Res(sRow + 1, d) = Res(sRow + 1, d) + Res(i, d)
End If
Next d
End If
Next i
Sheets("THTien").Range("E11").Resize(sRow + 1, 5) = Res
End Sub
