Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo Thoat
If Not Intersect(Target, Range("K6:K100000")) Is Nothing Then ' nêu có su thay dôi o K6-K100000 thi
d = Target.Row ' xác dinh dong có thay dôi
If IsArray(Target) Then ' kiêm tra xem thay dôi co phai là mang không (truong hop copy nhiêu dong paste vào ), nêu là mang thi
dong = Target.Rows.Count ' tính sô dong cua mang
Arr = Range("E6:K" & d + dong - 1).Value ' gán vung target (tu E6 dên K d+dong-1) là mang Arr
Else 'neu target không là mang (truong hop go vao 1 ô) thi
dong = 1
Arr = Range("E6:K" & d).Value ' gan dong tu E6 dên K là mang Arr
End If
R1 = UBound(Arr)
If DicMR Is Nothing Then Call Add_DicMR ' kiêm tra DicMR da có chua nêu chua thi chay code nap DicMR
For j = 1 To dong
If j > 1 Then d = d + 1 ' truong hop target là mang (dong>1)
dArr = Range(Cells(d, 5), Cells(d, 11)).Value ' xet tùng dong cua vung target gán thành mang dArr( chi co 1 dong)
If dArr(1, 1) = Empty And dArr(1, 2) = Empty Then 'xet mang dArr nêu dArr(1,i)=Rông (chính là E(d)=rông) và dArr(i,2)=Rông (chính là F(d)=rong) thi hiên thông báo
If MsgBox(" Xuât không có Job và NoDocument", vbYesNo, "THÔNG BÁO") = vbNo Then ' nêu Click No thi
Target = "" 'Ô G(d)= rông
GoTo Thoat ' thoat khoi code
Else ' neu chon Yes thi Nhay xuong doan code Chay (có nghia là cho phep xuat khong có Job và noDocu..)
GoTo Chay
End If
Else ' nêu co Job va NoDoCu thi nhay dên Chay
GoTo Chay
End If
Next j ' kêt thuc xet tung dong target
End If ' ket thuc su kien thay doi côt K
Chay:
Temp = Trim(dArr(1, 1)) & "|" & Trim(dArr(1, 2)) & "|" & Trim(dArr(1, 3)) ' XAC d?nh key cho dic
For i = 1 To R1 ' xet tung dong cua mang Arr tu E6 dên K dong+d-1
If Temp = Trim(Arr(i, 1)) & "|" & Trim(Arr(i, 2)) & "|" & Trim(Arr(i, 3)) Then 'so sanh voi key vói cac thanh phân cua mang Arr nêu = (giông nhau) thi
If DicMR.Exists(Temp) Then ' kiem tra trong Thu vien MR (dicMR) nêu da ton tai thi
t = t + 1 'sô lân xuât hiên key trong mang Arr
X = X + Arr(i, 7) ' Tông sô da xuat (công dôn)
If X > MR(DicMR.Item(Temp), 2) Then ' so sanh tông so da xuat voi sô liêu cua MR nêu lon hon thi
' MsgBox "Ma hàng này " & Temp & "da xuât " & t & " lân=" & X & Chr(10) & " Xuât lon hon MR. " & "(MR= " & MR(DicMR.Item(Temp), 2) & ")"
MsgBox " Job " & Temp & Chr(10) & " So luong MR = " & MR(DicMR.Item(Temp), 2) & Chr(10) & " So luong da xuat =" & X & Chr(10) & " So luong xuat nhieu hon MR = " & X - MR(DicMR.Item(Temp), 2)
Range("K" & d) = "" ' Xóa du liêu mói nhap vao côt K
GoTo Thoat ' Chay dên thoat
End If
End If
End If
Next i
Thoat:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Option Explicit
Public ChkMR As Boolean, DicMR As Object, MR()
Sub Add_DicMR()
Dim i&, t&, k&, R&, Lr&
Dim Arr(), key
Dim Sh As Worksheet
Set Sh = Sheets("MR")
Lr = Sh.Cells(Rows.Count, 9).End(xlUp).Row
Arr = Sh.Range("D6:Q" & Lr).Value
R = UBound(Arr)
Set DicMR = CreateObject("Scripting.Dictionary")
ReDim MR(1 To R, 1 To 3)
For i = 1 To R
If (Arr(i, 1)) <> Empty Then
key = Trim(Arr(i, 1)) & "|" & Trim(Arr(i, 3)) & "|" & Trim(Arr(i, 5))
If Not DicMR.Exists(key) Then
t = t + 1
DicMR.Add (key), t
If Arr(i, 6) <> Empty Then MR(t, 1) = Arr(i, 6)
MR(t, 2) = Arr(i, 7)
If Arr(i, 14) <> Empty Then MR(t, 3) = Arr(i, 14)
Else
MR(DicMR.Item(key), 2) = MR(DicMR.Item(key), 2) + Arr(i, 7)
End If
End If
Next i
End Sub
