Xin gíup làm gọn dữ liệu lại

[tle2003]

Báo cáo từ hệ thống ra excel , sheet 1 có 6 cột
A: Mã hàng
B: Mã phụ
C: Kệ hàng
D: Kho hàng
E: Số lượng
F: Lô hàng, do có nhiều lô hàng nên số dòng tăng lên , và do nhu cầu kiểm kho không cần kiểm lô hàng cho nên tôi tạo danh sách không trùng lập của A : D ở sheet2 , rồi dùng hàm sumifs ở dòng E.
Xin các bạn gíup code VBA cho cách làm trên.
Cám ơn

 

[HUONGHCKT]

Báo cáo từ hệ thống ra excel , sheet 1 có 6 cột
A: Mã hàng
B: Mã phụ
C: Kệ hàng
D: Kho hàng
E: Số lượng
F: Lô hàng, do có nhiều lô hàng nên số dòng tăng lên , và do nhu cầu kiểm kho không cần kiểm lô hàng cho nên tôi tạo danh sách không trùng lập của A : D ở sheet2 , rồi dùng hàm sumifs ở dòng E.
Xin các bạn gíup code VBA cho cách làm trên.
Cám ơn

Làm đại.
Bạn tham khảo code sau:

Option Explicit

Sub Tinh()
Dim i&, j&, t&, k&, Lr&
Dim Arr(), KQ()
Dim Dic As Object, Key
Dim Sh As Worksheet, Ws As Worksheet
Set Sh = Sheet1
Lr = Sh.Cells(100000, 1).End(xlUp).Row
Arr = Sh.Range("A2:F" & Lr).Value
ReDim KQ(1 To UBound(Arr), 1 To 6)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
    Key = Arr(i, 1) & "#" & Arr(i, 2) & "#" & Arr(i, 3) & "#" & Arr(i, 4)
    If Not Dic.Exists(Key) Then
        t = t + 1: Dic.Add (Key), t
        KQ(t, 1) = t
        KQ(t, 2) = Arr(i, 1)
        KQ(t, 3) = Arr(i, 2)
        KQ(t, 4) = Arr(i, 3)
        KQ(t, 5) = Arr(i, 4)
        KQ(t, 6) = Arr(i, 5)
    Else
        k = Dic.Item(Key)
        KQ(k, 6) = KQ(k, 6) + Arr(i, 5)
    End If
Next i
If t Then
    Set Ws = Sheet2
    Ws.Range("G2").Resize(100000, 6).ClearContents
    Ws.Range("G2").Resize(t, 6) = KQ
End If
Set Dic = Nothing
MsgBox "Done"
End Sub

Code chưa bẫy lỗi và định dạng trang kết quả, bạn tự làm.
Hy vọng đúng.

 

[tle2003]

Cám ơn Bác nhiều lắm