Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [g7]) Is Nothing Then
Dim Dat1 As Date, Dat2 As Date, J As Long, Rws As Long, W As Byte, Dm As Byte
Dim Sh As Worksheet, WF As Object, Cls As Range
Dim ShName As String
ReDim dArr(1 To 99, 1 To 3)
Dat2 = Target.Value
Dat1 = Target.Offset(-1).Value
Range("$AA$1:$AC$1").CurrentRegion.Delete
[C12:H92].ClearContents
Rows("12:99").Hidden = False
For W = 1 To 2
ShName = Choose(W, "Nhap", "Xuat", "GPE.COM")
Set Sh = ThisWorkbook.Worksheets(ShName)
Rws = Sh.[d9].CurrentRegion.Rows.Count
Dim Arr()
Arr() = Sh.[d11].Resize(Rws, 12 - W).Value
For J = 1 To UBound(Arr())
If Arr(J, 1) >= Dat1 And Arr(J, 1) <= Dat2 Then '***'
Dm = Dm + 1: dArr(Dm, 1) = Arr(J, 3)
dArr(Dm, 2) = Arr(J, 2)
dArr(Dm, 3) = Arr(J, 12 - W)
End If
Next J
Next W
Application.ScreenUpdating = False
If Dm Then
[aa1].Resize(Dm, 3).Value = dArr()
Range("$AA$1:$AC$1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlNo
[Ab2].CurrentRegion.Copy Destination:=[c12]
Set WF = Application.WorksheetFunction
For Each Cls In Range([c12], [C99].End(xlUp))
For W = 1 To 2
ShName = Choose(W, "Nhap", "Xuat", "GPE.COM")
Set Sh = ThisWorkbook.Worksheets(ShName)
Rws = Sh.[d9].CurrentRegion.Rows.Count
Sh.[AC2].Value = Cls.Value
Cls.Offset(, 3 + W).Value = WF.DSum(Sh.[d9].Resize(Rws, 17), Sh.Cells(9, 17 - W), Sh.[AA1:AC2])
Next W
Next Cls
Rows([C11].End(xlDown).Row + 1 & ":99").Hidden = True
End If
Application.ScreenUpdating = True
End If
End Sub
