Private Sub Worksheet_Change(ByVal Target As Range)
Dim tArr(), Res1(), Res2(), Nhap(), Xuat(), DanhMuc(), DonHang(), Dic As Object
Dim i As Long, k As Long, sRow As Long
Dim DotHang As String, ikey As String
If Target.Address(0, 0) = "I3" Then
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 GoTo Thoat
With Sheets("DanhMuc")
DanhMuc = .Range("B3:C" & .Range("B" & Rows.Count).End(xlUp).Row).Value
sRow = UBound(DanhMuc)
ReDim tArr(1 To sRow, 1 To 4)
DonHang = .Range("F3:H" & .Range("F" & Rows.Count).End(xlUp).Row).Value
End With
For i = 1 To UBound(DonHang)
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")
For i = 1 To sRow
ikey = UCase(DanhMuc(i, 1))
If Dic.exists(ikey) = False Then Dic.Add ikey, i
Next i
With Sheets("Nhap")
Nhap = .Range("D3:G" & .Range("D" & Rows.Count).End(xlUp).Row).Value
End With
For i = 1 To UBound(Nhap)
If UCase(Nhap(i, 4)) = DotHang Then
ik = Dic.Item(UCase(Nhap(i, 1)))
If ik > 0 Then
tArr(ik, 4) = tArr(ik, 4) + Nhap(i, 3)
Else 'Danh Muc NVL bi thieu
MsgBox ("Cap nhat lai danh muc nguyen vat lieu theo du lieu Nhap"): GoTo Thoat
End If
End If
Next i
With Sheets("Xuat")
Xuat = .Range("E3:H" & .Range("E" & Rows.Count).End(xlUp).Row).Value
End With
For i = 1 To UBound(Xuat)
If UCase(Xuat(i, 4)) = DotHang Then
ik = Dic.Item(UCase(Xuat(i, 1)))
If ik > 0 Then
tArr(ik, 3) = tArr(ik, 3) + Xuat(i, 3)
Else 'Danh Muc NVL bi thieu
MsgBox ("Cap nhat lai danh muc nguyen vat lieu theo du lieu Xuat"): GoTo Thoat
End If
End If
Next i
ReDim Res1(1 To sRow, 1 To 3)
ReDim Res2(1 To sRow, 1 To 3)
For i = 1 To sRow
If Len(tArr(i, 3)) > 0 Or Len(tArr(i, 4)) > 0 Then
k = k + 1
Res1(k, 1) = k: Res1(k, 2) = DanhMuc(i, 1): Res1(k, 3) = DanhMuc(i, 2)
Res2(k, 1) = tArr(i, 3): Res2(k, 2) = tArr(i, 4)
Res2(k, 3) = tArr(i, 4) - tArr(i, 3)
If Res2(k, 3) = 0 Then Res2(k, 3) = Empty
End If
Next i
If k Then
Range("A6:C6").Resize(k) = Res1
Range("F6:H6").Resize(k) = Res2
End If
Range("A6:I6").Resize(k).Borders.LineStyle = 1
Range("F6:H6").Resize(k).NumberFormat = "#,##0_);[Red]- #,##0_)"
Thoat:
Application.ScreenUpdating = True
End If
End Sub
