Tổng hợp các dữ liệu Trùng và Cộng Dồn Theo điều kiện

- Đây là yêu cầu của đề bài:

- và đây là kết quả cần xuất ra

- Code:

-----------------------------------------------------------------------------------------------------------------

Sub UniqueData()

    Dim dongcuoi As Long, arrdata As Variant, dic As Object

    Dim i As Long, kq As Variant, k As Long, j As Byte

    Set dic = CreateObject("Scripting.Dictionary")

    With Sheet1

        dongcuoi = .Range("b65536").End(3).Row

        arrdata = .Range("b2:E" & dongcuoi).Value

    End With

    For i = 1 To UBound(arrdata)

        dic(arrdata(i, 1) & arrdata(i, 2)) = ""

    Next i

    ReDim kq(1 To dic.Count, 1 To 4)

    dic.RemoveAll

    For i = 1 To UBound(arrdata)

        If Not dic.exists(arrdata(i, 1) & arrdata(i, 2)) Then

            k = k + 1

            dic.Add arrdata(i, 1) & arrdata(i, 2), k

            For j = 1 To 4

                kq(k, j) = arrdata(i, j)

            Next j

        Else

            kq(dic.Item(arrdata(i, 1) & arrdata(i, 2)), 3) = _

                kq(dic.Item(arrdata(i, 1) & arrdata(i, 2)), 3) + arrdata(i, 3)

            kq(dic.Item(arrdata(i, 1) & arrdata(i, 2)), 4) = _

                kq(dic.Item(arrdata(i, 1) & arrdata(i, 2)), 4) + arrdata(i, 4)

        End If

    Next i

    With Sheet2

        .Range("2:65536").ClearContents

        .Range("B2").Resize(k, 4).Value = kq

    End With
    msgbox "Done!"

End Sub

-----------------------------------------------------------------------------------------------------------------

- Cách thực hiện: các bạn tạo 1 nút bấm và gán macro cho nó, như video bên dưới: