Giúp em code tổng số lượng mã phế liệu theo từng vị trí kho theo từng tháng?

[hitlecp]

Em chào anh, chị
Em có file dữ liệu cần tổng hợp tổng số lượng mã phế liệu theo từng vị trí kho, theo từng tháng nguồn dữ liệu được lấy từ sheet ZMMPG95 cho kết quả từ hàng A6, có những tháng 1 mã phế liệu nằm ở 2 vị trí kho nên nhờ anh chị hỗ trợ giúp em ạ. (em có đính kèm file)
Em cảm ơn.

 

[HUONGHCKT]

Em chào anh, chị
Em có file dữ liệu cần tổng hợp tổng số lượng mã phế liệu theo từng vị trí kho, theo từng tháng nguồn dữ liệu được lấy từ sheet ZMMPG95 cho kết quả từ hàng A6, có những tháng 1 mã phế liệu nằm ở 2 vị trí kho nên nhờ anh chị hỗ trợ giúp em ạ. (em có đính kèm file)
Em cảm ơn.

Tham khảo code sau:

Option Explicit

Sub TongHop()
Dim i&, k&, Lr&, T&, ik&, R&
Dim Arr(), KQ()
Dim Dic As Object, Key
Dim Sh As Worksheet, Ws As Worksheet
Set Sh = Sheets("ZMMPG95")
Lr = Sh.Range("A" & Rows.Count).End(xlUp).Row
Arr = Sh.Range("A2:O" & Lr).Value
R = UBound(Arr)
Set Dic = CreateObject("Scripting.Dictionary")
ReDim KQ(1 To R, 1 To 16)
For i = 1 To R
    T = Month(Arr(i, 1)) + 4
    Key = Arr(i, 4) & "|" & Arr(i, 2)
    If Not Dic.Exists(Key) Then
        k = k + 1: Dic.Add (Key), k
        KQ(k, 1) = Arr(i, 4)
        KQ(k, 2) = Arr(i, 5)
        KQ(k, 3) = Arr(i, 2)
        KQ(k, 4) = Application.WorksheetFunction.VLookup(Arr(i, 2), Sheets("Storage Location").Range("A1:B27"), 2, 0)
        KQ(k, T) = Arr(i, 7)
    Else
        ik = Dic.Item(Key)
        KQ(ik, T) = KQ(ik, T) + Arr(i, 7)
    End If
Next i
If k Then
    Set Ws = Sheets("TH")
    Ws.Range("A12").Resize(k, 16) = KQ   ' Thay chỗ A12 thành chỗ định gán kết quả
End If
Set Dic = Nothing
Msgbox "Done"
End Sub

 

[hitlecp]

Tham khảo code sau:

Option Explicit

Sub TongHop()
Dim i&, k&, Lr&, T&, ik&, R&
Dim Arr(), KQ()
Dim Dic As Object, Key
Dim Sh As Worksheet, Ws As Worksheet
Set Sh = Sheets("ZMMPG95")
Lr = Sh.Range("A" & Rows.Count).End(xlUp).Row
Arr = Sh.Range("A2:O" & Lr).Value
R = UBound(Arr)
Set Dic = CreateObject("Scripting.Dictionary")
ReDim KQ(1 To R, 1 To 16)
For i = 1 To R
    T = Month(Arr(i, 1)) + 4
    Key = Arr(i, 4) & "|" & Arr(i, 2)
    If Not Dic.Exists(Key) Then
        k = k + 1: Dic.Add (Key), k
        KQ(k, 1) = Arr(i, 4)
        KQ(k, 2) = Arr(i, 5)
        KQ(k, 3) = Arr(i, 2)
        KQ(k, 4) = Application.WorksheetFunction.VLookup(Arr(i, 2), Sheets("Storage Location").Range("A1:B27"), 2, 0)
        KQ(k, T) = Arr(i, 7)
    Else
        ik = Dic.Item(Key)
        KQ(ik, T) = KQ(ik, T) + Arr(i, 7)
    End If
Next i
If k Then
    Set Ws = Sheets("TH")
    Ws.Range("A12").Resize(k, 16) = KQ   ' Thay chỗ A12 thành chỗ định gán kết quả
End If
Set Dic = Nothing
Msgbox "Done"
End Sub
[/CODE
[/QUOTE]

Tham khảo code sau:

Option Explicit

Sub TongHop()
Dim i&, k&, Lr&, T&, ik&, R&
Dim Arr(), KQ()
Dim Dic As Object, Key
Dim Sh As Worksheet, Ws As Worksheet
Set Sh = Sheets("ZMMPG95")
Lr = Sh.Range("A" & Rows.Count).End(xlUp).Row
Arr = Sh.Range("A2:O" & Lr).Value
R = UBound(Arr)
Set Dic = CreateObject("Scripting.Dictionary")
ReDim KQ(1 To R, 1 To 16)
For i = 1 To R
    T = Month(Arr(i, 1)) + 4
    Key = Arr(i, 4) & "|" & Arr(i, 2)
    If Not Dic.Exists(Key) Then
        k = k + 1: Dic.Add (Key), k
        KQ(k, 1) = Arr(i, 4)
        KQ(k, 2) = Arr(i, 5)
        KQ(k, 3) = Arr(i, 2)
        KQ(k, 4) = Application.WorksheetFunction.VLookup(Arr(i, 2), Sheets("Storage Location").Range("A1:B27"), 2, 0)
        KQ(k, T) = Arr(i, 7)
    Else
        ik = Dic.Item(Key)
        KQ(ik, T) = KQ(ik, T) + Arr(i, 7)
    End If
Next i
If k Then
    Set Ws = Sheets("TH")
    Ws.Range("A12").Resize(k, 16) = KQ   ' Thay chỗ A12 thành chỗ định gán kết quả
End If
Set Dic = Nothing
Msgbox "Done"
End Sub

Em cảm ơn ạ