Tổng hợp số liệu bằng dictionary (1 người xem)

[bongmaihung]

Em nhờ anh chị giúp em đoạn code vba tổng hợp lại nhập xuất tồn. File đã làm bằng hàm nhưng dữ liệu nhiểu oải quá . Chi tiết em nêu trong sheet hue.
Sheet kdt va vuon có thể có nhiều mã lập lại, em cảm ơn.

 

[comet_1701]

Em nhờ anh chị giúp em đoạn code vba tổng hợp lại nhập xuất tồn. File đã làm bằng hàm nhưng dữ liệu nhiểu oải quá . Chi tiết em nêu trong sheet hue.
Sheet kdt va vuon có thể có nhiều mã lập lại, em cảm ơn.

Sub Dic()
Dim sarr, arr(1 To 65000, 1 To 10), i, j, k
Dim Ws As Worksheet, Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
    If Ws.Name = "VUON" Or Ws.Name = "KDT" Then
        sarr = Ws.Range("B6", Ws.[B65000].End(xlUp)).Resize(, 6).Value2
            For i = 1 To UBound(sarr, 1)
                If Not Dic.exists(sarr(i, 1)) Then
                    k = k + 1
                    Dic.Add sarr(i, 1), k
                    arr(k, 1) = sarr(i, 1)
                    If Ws.Name = "VUON" Then
                        arr(k, 2) = sarr(i, 2)
                        arr(k, 3) = sarr(i, 3)
                    Else
                        arr(k, 5) = sarr(i, 2)
                        arr(k, 6) = sarr(i, 3)
                    End If
                Else
                    If Ws.Name = "VUON" Then
                        arr(Dic.Item(sarr(i, 1)), 2) = arr(Dic.Item(sarr(i, 1)), 2) + sarr(i, 2)
                        arr(Dic.Item(sarr(i, 1)), 3) = arr(Dic.Item(sarr(i, 1)), 3) + sarr(i, 3)
                    Else
                        arr(Dic.Item(sarr(i, 1)), 5) = arr(Dic.Item(sarr(i, 1)), 5) + sarr(i, 2)
                        arr(Dic.Item(sarr(i, 1)), 6) = arr(Dic.Item(sarr(i, 1)), 6) + sarr(i, 3)
                    End If
                End If
            Next i
    End If
Next Ws
With Sheets("HUE")
    If k Then
        .[A8:j65000].ClearContents
        .[A8].Resize(k, 10).Value = arr
    End If
End With
                
        


End Sub

đây là ý tưởng, mình đang vội, bạn thử triển khai tiếp xem sao nhé, chúc bạn thành công

 

[ChanhTQ@]

================>>>=================>>>

 

[bongmaihung]

Em đã thử thành công, cảm ơn mọi người đã giúp đỡ.