Private Sub Worksheet_Change(ByVal Target As Range)
Dim Res1(), Res2(), Nhap(), Xuat(), DonHang(), Dic As Object
Dim i&, k&, ik&, sRow&
Dim DotHang As String, ikey As String
If Target.Address(0, 0) = "I3" Then
Application.EnableEvents = False
Application.ScreenUpdating = False
eRow = Range("A" & Rows.Count).End(xlUp).Row
If eRow > 5 Then Range("A6:I" & eRow).Clear
DotHang = UCase(Target.Value)
If Len(DotHang) = 0 Then
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
End If
With Sheets("DanhMuc")
DonHang = .Range("F3:H" & .Range("F" & Rows.Count).End(xlUp).Row).Value
End With
sRow = UBound(DonHang)
For i = 1 To sRow
If UCase(DonHang(i, 2)) = DotHang Then
Range("E2") = DonHang(i, 1)
Range("G2") = DonHang(i, 3)
Exit For
End If
Next i
Set Dic = CreateObject("scripting.dictionary")
With Sheets("Nhap")
Nhap = .Range("D3:G" & .Range("D" & Rows.Count).End(xlUp).Row).Value
End With
With Sheets("Xuat")
Xuat = .Range("E3:I" & .Range("E" & Rows.Count).End(xlUp).Row).Value
End With
ReDim Res1(1 To UBound(Nhap) + UBound(Xuat), 1 To 2)
ReDim Res2(1 To UBound(Nhap) + UBound(Xuat), 1 To 4)
sRow = UBound(Nhap)
For i = 1 To sRow
If UCase(Nhap(i, 4)) = DotHang Then
ikey = UCase(Nhap(i, 1))
If Dic.exists(ikey) = False Then
k = k + 1
Dic.Add ikey, k
Res1(k, 1) = Nhap(i, 1): Res1(k, 2) = Nhap(i, 2)
End If
ik = Dic.Item(ikey)
Res2(ik, 2) = Res2(ik, 2) + Nhap(i, 3)
Res2(ik, 3) = Res2(ik, 3) + Nhap(i, 3)
End If
Next i
sRow = UBound(Xuat)
For i = 1 To sRow
If UCase(Xuat(i, 4)) = DotHang Then
ikey = UCase(Xuat(i, 1))
If Dic.exists(ikey) = False Then
k = k + 1
Dic.Add ikey, k
Res1(k, 1) = Xuat(i, 1): Res1(k, 2) = Xuat(i, 2)
End If
ik = Dic.Item(ikey)
Res2(ik, 1) = Res2(ik, 1) + Xuat(i, 3)
If UCase(Xuat(i, 4)) = UCase(Xuat(i, 5)) Then
Res2(ik, 3) = Res2(ik, 3) - Xuat(i, 3)
Else
Res2(ik, 4) = Res2(ik, 4) & ", " & Xuat(i, 5) & "(-" & Xuat(i, 3) & ")"
End If
End If
If UCase(Xuat(i, 4)) <> UCase(Xuat(i, 5)) Then
If UCase(Xuat(i, 5)) = DotHang Then
ikey = UCase(Xuat(i, 1))
If Dic.exists(ikey) = False Then
k = k + 1
Dic.Add ikey, k
Res1(k, 1) = Xuat(i, 1): Res1(k, 2) = Xuat(i, 2)
End If
ik = Dic.Item(ikey)
Res2(ik, 3) = Res2(ik, 3) - Xuat(i, 3)
Res2(ik, 4) = Res2(ik, 4) & ", " & Xuat(i, 4) & "(+" & Xuat(i, 3) & ")"
End If
End If
Next i
If k Then
For i = 1 To k
ikey = Res2(i, 4)
If Len(ikey) Then Res2(i, 4) = Mid(ikey, 3, Len(ikey) - 2)
Next i
Range("B6:C6").Resize(k) = Res1
Range("F6:I6").Resize(k) = Res2
Range("A6:I6").Resize(k).Borders.LineStyle = 1
Range("F6:H6").Resize(k).NumberFormat = "#,##0_);[Red]- #,##0_)"
Range("B5:I5").Resize(k).Sort [B5], Header:=xlYes
Range("A6") = 1
Range("A6").Resize(k).DataSeries
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End Sub