Nhờ giúp đỡ code tổng hợp số lượng theo điều kiện

[Shaa]

Chào các bác,
em đang muốn tổng hợp số lượng theo điều kiện hiển thị
Cụ thể em có gửi ví dụ trong tệp đính kèm và ảnh
Các bác giúp em cái code với nhé, em cảm ơn ạ!

 

[BuiQuangThuan]

Cái này sài pivottable có khi được đó

 

[Shaa]

Cái này sài pivottable có khi được đó

Nếu không trùng INV còn nối lại với nhau nữa, đoạn này em chưa biết phải dùng pivot thế nào bác ạ

 

[BuiQuangThuan]

Nếu không trùng INV còn nối lại với nhau nữa, đoạn này em chưa biết phải dùng pivot thế nào bác ạ

Là gợi ý theo cách mình nghĩ thôi. Đang dở việc chút. Chưa hỗ trợ ngay được. Chờ thành viên khác xem thế nào. Nếu chưa được hỗ trợ mình sẽ code thử xem thế nào. Nhưng chưa phải lúc này

 

[Duy Tùng 9x]

Chào các bác,
em đang muốn tổng hợp số lượng theo điều kiện hiển thị
Cụ thể em có gửi ví dụ trong tệp đính kèm và ảnh
Các bác giúp em cái code với nhé, em cảm ơn ạ!

Excel nào bạn. Này có thể dùng power pivot. Viết dax để nối cái cột INV với nhau là được. Thử thêm cái measure này xem sao:
=CONCATENATEX(DISTINCT(Table1[INV]), Table1[INV], "-")
Hàm hơi nhì nhằng

 

[DeTong]

Nếu không trùng INV còn nối lại với nhau nữa, đoạn này em chưa biết phải dùng pivot thế nào bác ạ

M Code cho thớt tham khảo.

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    ChangedType = Table.TransformColumnTypes(Source,{{"INV", type text}, {"Qty", Int64.Type}, {"CD#", type text}}),
    GroupedRows = Table.Group(ChangedType, {"CD#"}, {{"Amount", each List.Sum([Qty])},{"Invoice", each Text.Combine(List.Distinct([INV]),"-")}})
in
    GroupedRows

 

[snow25]

Chào các bác,
em đang muốn tổng hợp số lượng theo điều kiện hiển thị
Cụ thể em có gửi ví dụ trong tệp đính kèm và ảnh
Các bác giúp em cái code với nhé, em cảm ơn ạ!

Bạn thử code dưới hên sui.

Sub abc()
    Dim i As Long, lr As Long, arr, dic, kq, a As Long, kq1, b As Integer, c As Integer, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet1")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A3:C" & lr).Value
        ReDim kq(1 To UBound(arr), 1 To 3)
        For i = 1 To UBound(arr)
            dk = arr(i, 3) & "#" & arr(i, 1)
            If Not dic.exists(dk) Then
               a = a + 1
               dic.Add dk, a
               kq(a, 1) = arr(i, 1)
               kq(a, 2) = arr(i, 2)
               kq(a, 3) = arr(i, 3)
            Else
               b = dic.Item(dk)
               kq(b, 2) = arr(i, 2) + kq(b, 2)
            End If
       Next i
       ReDim kq1(1 To a, 1 To 3)
       For i = 1 To a
           dk = kq(i, 3)
           If Not dic.exists(dk) Then
              c = c + 1
              dic.Add dk, c
              kq1(c, 1) = kq(i, 1)
              kq1(c, 2) = kq(i, 3)
              kq1(c, 3) = kq(i, 2)
           Else
              b = dic.Item(dk)
              kq1(b, 1) = kq1(b, 1) & "-" & kq(i, 1)
              kq1(b, 3) = kq1(b, 3) + kq(i, 2)
           End If
       Next i
       .Range("J3:L10000").ClearContents
        .Range("J3:L3").Resize(c).Value = kq1
   End With
   Set dic = Nothing
End Sub

 

[Shaa]

M Code cho thớt tham khảo.

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    ChangedType = Table.TransformColumnTypes(Source,{{"INV", type text}, {"Qty", Int64.Type}, {"CD#", type text}}),
    GroupedRows = Table.Group(ChangedType, {"CD#"}, {{"Amount", each List.Sum([Qty])},{"Invoice", each Text.Combine(List.Distinct([INV]),"-")}})
in
    GroupedRows

Em cảm ơn bác nhiều ạ, cái M code này em còn khá lạ lẫm, e sẽ nghiên cứu thêm

Bài đã được tự động gộp: Thứ năm lúc 14:52

Bạn thử code dưới hên sui.

Sub abc()
    Dim i As Long, lr As Long, arr, dic, kq, a As Long, kq1, b As Integer, c As Integer, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet1")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A3:C" & lr).Value
        ReDim kq(1 To UBound(arr), 1 To 3)
        For i = 1 To UBound(arr)
            dk = arr(i, 3) & "#" & arr(i, 1)
            If Not dic.exists(dk) Then
               a = a + 1
               dic.Add dk, a
               kq(a, 1) = arr(i, 1)
               kq(a, 2) = arr(i, 2)
               kq(a, 3) = arr(i, 3)
            Else
               b = dic.Item(dk)
               kq(b, 2) = arr(i, 2) + kq(b, 2)
            End If
       Next i
       ReDim kq1(1 To a, 1 To 3)
       For i = 1 To a
           dk = kq(i, 3)
           If Not dic.exists(dk) Then
              c = c + 1
              dic.Add dk, c
              kq1(c, 1) = kq(i, 1)
              kq1(c, 2) = kq(i, 3)
              kq1(c, 3) = kq(i, 2)
           Else
              b = dic.Item(dk)
              kq1(b, 1) = kq1(b, 1) & "-" & kq(i, 1)
              kq1(b, 3) = kq1(b, 3) + kq(i, 2)
           End If
       Next i
       .Range("J3:L10000").ClearContents
        .Range("J3:L3").Resize(c).Value = kq1
   End With
   Set dic = Nothing
End Sub

Em cảm ơn bác nhiều ạ, kết quả đúng rồi ạ

 

[BuiQuangThuan]

Các bác giúp em cái code với nhé, em cảm ơn ạ!

Thêm cách khác tham khảo

Sub abc()
    Dim d As Object, a(), r(), i&, key, s, k&, tam$
    Set d = CreateObject("scripting.dictionary")
    With Sheets("Sheet1")
        a = .Range("A3:C17").Value
        For i = 1 To UBound(a)
            d(a(i, 3)) = d(a(i, 3)) & "|" & i
        Next
        ReDim r(1 To UBound(a), 1 To 3)
        For Each key In d.keys
            s = Split(d(key), "|")
            k = k + 1
            r(k, 2) = key
            For i = 1 To UBound(s)
                If InStr(1, a(s(i), 1), tam) > 0 Then tam = a(s(i), 1) Else tam = tam & "-" & a(s(i), 1)
                r(k, 3) = r(k, 3) + a(s(i), 2)
            Next
            r(k, 1) = tam
            tam = Empty
        Next
        .Range("K3").Resize(k, 3).Value = r
    End With
End Sub

 

[Shaa]

Thêm cách khác tham khảo

Sub abc()
    Dim d As Object, a(), r(), i&, key, s, k&, tam$
    Set d = CreateObject("scripting.dictionary")
    With Sheets("Sheet1")
        a = .Range("A3:C17").Value
        For i = 1 To UBound(a)
            d(a(i, 3)) = d(a(i, 3)) & "|" & i
        Next
        ReDim r(1 To UBound(a), 1 To 3)
        For Each key In d.keys
            s = Split(d(key), "|")
            k = k + 1
            r(k, 2) = key
            For i = 1 To UBound(s)
                If InStr(1, a(s(i), 1), tam) > 0 Then tam = a(s(i), 1) Else tam = tam & "-" & a(s(i), 1)
                r(k, 3) = r(k, 3) + a(s(i), 2)
            Next
            r(k, 1) = tam
            tam = Empty
        Next
        .Range("K3").Resize(k, 3).Value = r
    End With
End Sub

cảm ơn bác nhiều ạ