Nhờ anh ndu96081631 xem giúp
trong bài toán trích lọc danh sách duy nhất và tổng hợp dữ liệu với 2 điều kiện
1. trùng part code
2. trùng Delivery date
thì tổng hợp dữ liệu số lượng (Qty) từ sheet Po sang sheet linkpo như file đính kèm
nhưng trong code hiện tại chưa đáp ứng được điều kiện thứ 2
vì khi xóa dữ liệu ngày ở sheet linkpo từ ô G9 trở đi thì vẫn ra kết quả bình thường
Vậy nhờ anh chị GPE xem sửa giúp code để thỏa mãn cả điều kiện thứ 2
Sub linkpo()
On Error GoTo 1:
Dim Rng(), Arr(), Dic As Object, t, lCal
Dim c As Long, i As Long, K As Long, D As Long, Tem As String
Application.ScreenUpdating = False
lCal = Application.Calculation: Application.Calculation = xlCalculationManual
t = Timer
Const nCol = 1000
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("linkpo")
K = .[B15000].End(xlUp).Row:
If K > 2 Then .[A10].Resize(K - 2, nCol).ClearContents
D = .[F9].Value
End With
With Sheets("po"): Rng = .Range(.[B5], .[B15000].End(xlUp)).Resize(, 11).Value: End With
ReDim Arr(1 To UBound(Rng, 1), 1 To nCol)
K = 0
For i = 1 To UBound(Rng, 1)
If Rng(i, 10) <> "" Then
c = Rng(i, 10) - D + 6
Tem = Rng(i, 1)
If Dic.Exists(Tem) Then
Arr(Dic.Item(Rng(i, 1)), c) = Arr(Dic.Item(Rng(i, 1)), c) + Rng(i, 11)
Else
K = K + 1: Dic.Add (Tem), K
Arr(K, 1) = K: Arr(K, 3) = Tem: Arr(K, c) = Rng(i, 11)
Arr(K, 4) = Rng(i, 2)
End If
End If
Next i
Set Dic = Nothing
Sheets("linkpo").[A10].Resize(K, nCol).Value = Arr
With Sheets("linkpo")
Range("B10").Select
ActiveCell.FormulaR1C1 = "=vlookupD(RC[1],'Master list'!R2C2:R50C3,2,3,1)"
Range("B10").Select
Selection.AutoFill Destination:=Range("B10:B48")
Range("E10").Select
ActiveCell.FormulaR1C1 = "=vlookupD(RC[-2],'Master list'!R2C3:R50C5,3,2,1)"
Range("E10").Select
Selection.AutoFill Destination:=Range("E10:E48")
Range("B10").Select
End With
1: Application.ScreenUpdating = True: Application.Calculation = lCal
End Sub
