Gom dữ liệu theo điều kiện tiêu đề

[Tien Long]

Chào mọi người,
Tôi có một file dữ liệu mà chưa biết cách tổng hợp như thế nào nhờ mọi người giúp đỡ.
Yêu cầu:
Dựa vào dữ liệu từ sheet DATA tính tổng số lượng cột L theo điều kiện ở cột B,C,E,F,H,I và cột K tương ứng với H1:U1 ở sheet RES.
Tôi có làm thử với pivot table, nhờ mọi người code VBA giúp. xin cảm ơn mọi người.

 

[Ronaldinho7]

Chào mọi người,
Tôi có một file dữ liệu mà chưa biết cách tổng hợp như thế nào nhờ mọi người giúp đỡ.
Yêu cầu:
Dựa vào dữ liệu từ sheet DATA tính tổng số lượng cột L theo điều kiện ở cột B,C,E,F,H,I,J và cột K tương ứng với H1:U1 ở sheet RES.
Tôi có làm thử với pivot table, nhờ mọi người code VBA giúp. xin cảm ơn mọi người.

Nó giống như sumifs nhưng mình chưa hiểu chỗ

K tương ứng với H1:U1 ở sheet RES.

Là sao nhỉ?

 

[Tien Long]

Nó giống như sumifs nhưng mình chưa hiểu chỗ

Là sao nhỉ?

Vùng H1:U1 ở sheet RES là lấy từ Cột K ở sheet data á bạn, mình đã lấy ra và cố định nó làm tiêu đề luôn.

 

[Ronaldinho7]

Bạn thử kiểm tra lại kết quả xem ha!

Option Explicit
Sub GPE()
    Dim Arr(), Res(), Dic As Object, Key$
    Dim i&, j&, k&, Lr&, sArr()
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("DATA")
        Lr = .Range("B" & Rows.Count).End(xlUp).Row
        Arr = .Range("B2:L" & Lr).Value
        sArr = Sheets("KQ").Range("H1:U1").Value
        ReDim Res(1 To UBound(Arr), 1 To 20)
        For i = 1 To UBound(Arr, 1)
            Key = Arr(i, 1) & "_" & Arr(i, 2) & "_" & Arr(i, 4) & "_" & Arr(i, 5) & _
            Arr(i, 7) & "_" & Arr(i, 8) & "_" & Arr(i, 9)
            If Not Dic.exists(Key) Then
                k = k + 1
                Dic.Add (Key), k
                Res(k, 1) = Arr(i, 1): Res(k, 2) = Arr(i, 2): Res(k, 3) = Arr(i, 4)
                Res(k, 4) = Arr(i, 5): Res(k, 5) = Arr(i, 7): Res(k, 6) = Arr(i, 8)
                For j = 1 To UBound(sArr, 2)
                    If Arr(i, 10) = sArr(1, j) Then
                        Res(k, 6 + j) = Arr(i, 11)
                    End If
                Next j
            Else
                For j = 1 To UBound(sArr, 2)
                    If Arr(i, 10) = sArr(1, j) Then
                        Res(Dic.Item(Key), 6 + j) = Res(Dic.Item(Key), 6 + j) + Arr(i, 11)
                    End If
                Next j
            End If
        Next i
    End With
    If k Then
        Sheets("KQ").Range("B2:U100000").ClearContents
        Sheets("KQ").Range("B2").Resize(k, 20).Value = Res
    End If
    MsgBox "Done"
    Set Dic = Nothing
End Sub

 

[Tien Long]

Bạn thử kiểm tra lại kết quả xem ha!

Option Explicit
Sub GPE()
    Dim Arr(), Res(), Dic As Object, Key$
    Dim i&, j&, k&, Lr&, sArr()
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("DATA")
        Lr = .Range("B" & Rows.Count).End(xlUp).Row
        Arr = .Range("B2:L" & Lr).Value
        sArr = Sheets("KQ").Range("H1:U1").Value
        ReDim Res(1 To UBound(Arr), 1 To 20)
        For i = 1 To UBound(Arr, 1)
            Key = Arr(i, 1) & "_" & Arr(i, 2) & "_" & Arr(i, 4) & "_" & Arr(i, 5) & _
            Arr(i, 7) & "_" & Arr(i, 8) & "_" & Arr(i, 9)
            If Not Dic.exists(Key) Then
                k = k + 1
                Dic.Add (Key), k
                Res(k, 1) = Arr(i, 1): Res(k, 2) = Arr(i, 2): Res(k, 3) = Arr(i, 4)
                Res(k, 4) = Arr(i, 5): Res(k, 5) = Arr(i, 7): Res(k, 6) = Arr(i, 8)
                For j = 1 To UBound(sArr, 2)
                    If Arr(i, 10) = sArr(1, j) Then
                        Res(k, 6 + j) = Arr(i, 11)
                    End If
                Next j
            Else
                For j = 1 To UBound(sArr, 2)
                    If Arr(i, 10) = sArr(1, j) Then
                        Res(Dic.Item(Key), 6 + j) = Res(Dic.Item(Key), 6 + j) + Arr(i, 11)
                    End If
                Next j
            End If
        Next i
    End With
    If k Then
        Sheets("KQ").Range("B2:U100000").ClearContents
        Sheets("KQ").Range("B2").Resize(k, 20).Value = Res
    End If
    MsgBox "Done"
    Set Dic = Nothing
End Sub

Cảm ơn bạn đã hỗ trợ nha.