Xin giúp code lọc dữ liệu

[happyghost2000]

Chào các Anh , Chị
Em có dữ liệu Order Chi tiết bảng A, Em muốn nó tự động Group dữ liệu qua bảng B như hình bên dưới.
Khi thêm dữ liệu Order vào bảng A, thì bảng B tự động chạy luôn .
Cột AC đến AO là tổng từng cột H đến T
Mong hỗ trợ giúp em .
Em cám ơn rất nhiều.

 

[HUONGHCKT]

Chào các Anh , Chị
Em có dữ liệu Order Chi tiết bảng A, Em muốn nó tự động Group dữ liệu qua bảng B như hình bên dưới.
Khi thêm dữ liệu Order vào bảng A, thì bảng B tự động chạy luôn .
Cột AC đến AO là tổng từng cột H đến T
Mong hỗ trợ giúp em .
Em cám ơn rất nhiều.
View attachment 261754

Bạn không nên viết hoa ở tiêu đề như thế là vi phạm nội quy, và sẽ không có ai giúp bạn
Nện sửa lại.

 

[happyghost2000]

Bạn không nên viết hoa ở tiêu đề như thế là vi phạm nội quy, và sẽ không có ai giúp bạn
Nện sửa lại.

Cám ơn bạn mình sẽ sửa lại tiêu đề

 

[Ba Tê]

Cám ơn bạn mình sẽ sửa lại tiêu đề

Chữ tiếng gì không biết, thấy sao làm vậy:

Option Explicit

Public Sub Gpe()
Const Cols As Long = 20
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Rws As Long, Txt As String
    sArr = Range("A3", Range("A3").End(xlDown)).Resize(, Cols).Value
    Rws = UBound(sArr)
ReDim dArr(1 To Rws, 1 To Cols)
With CreateObject("Scripting.Dictionary")
    For I = 1 To Rws
        Txt = Empty
        For J = 1 To 5
            Txt = Txt & sArr(I, J) & "#"
        Next J
        If Not .Exists(Txt) Then
            K = K + 1
            .Item(Txt) = K
            For J = 1 To Cols
                dArr(K, J) = sArr(I, J)
            Next J
            dArr(K, 6) = Empty: dArr(K, 7) = Empty
        Else
            R = .Item(Txt)
            For J = 8 To Cols
                If sArr(I, J) > 0 Then dArr(R, J) = dArr(R, J) + sArr(I, J)
            Next J
        End If
    Next I
End With
Range("V3").Resize(10000, Cols).ClearContents
Range("V3").Resize(K, Cols) = dArr
End Sub

 

[HUONGHCKT]

Chào các Anh , Chị
Em có dữ liệu Order Chi tiết bảng A, Em muốn nó tự động Group dữ liệu qua bảng B như hình bên dưới.
Khi thêm dữ liệu Order vào bảng A, thì bảng B tự động chạy luôn .
Cột AC đến AO là tổng từng cột H đến T
Mong hỗ trợ giúp em .
Em cám ơn rất nhiều.
View attachment 261754

Góp thêm một code, thử xem sao.
bạn thêm tháng khác, mã khác, loại khác( 5 cột đầu tiên ) và chạy thử nhé

 

[happyghost2000]

Góp thêm một code, thử xem sao.
bạn thêm tháng khác, mã khác, loại khác( 5 cột đầu tiên ) và chạy thử nhé

Xin cám ơn bạn . rất nhiều

Bài đã được tự động gộp: 3/7/21

Chữ tiếng gì không biết, thấy sao làm vậy:

Option Explicit

Public Sub Gpe()
Const Cols As Long = 20
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Rws As Long, Txt As String
    sArr = Range("A3", Range("A3").End(xlDown)).Resize(, Cols).Value
    Rws = UBound(sArr)
ReDim dArr(1 To Rws, 1 To Cols)
With CreateObject("Scripting.Dictionary")
    For I = 1 To Rws
        Txt = Empty
        For J = 1 To 5
            Txt = Txt & sArr(I, J) & "#"
        Next J
        If Not .Exists(Txt) Then
            K = K + 1
            .Item(Txt) = K
            For J = 1 To Cols
                dArr(K, J) = sArr(I, J)
            Next J
            dArr(K, 6) = Empty: dArr(K, 7) = Empty
        Else
            R = .Item(Txt)
            For J = 8 To Cols
                If sArr(I, J) > 0 Then dArr(R, J) = dArr(R, J) + sArr(I, J)
            Next J
        End If
    Next I
End With
Range("V3").Resize(10000, Cols).ClearContents
Range("V3").Resize(K, Cols) = dArr
End Sub

Xin cám ơn Anh rất nhiều .

 

[Ba Tê]

Góp thêm một code, thử xem sao.
bạn thêm tháng khác, mã khác, loại khác( 5 cột đầu tiên ) và chạy thử nhé

    For j = 1 To UBound(sArray, 2)
          aResult(t, j) = sArray(i, j)
          aResult(t, 6) = Empty
          aResult(t, 7) = Empty
...................................................
j=1 to 20, sẽ gán 20 lần:

    aResult(t, 6) = Empty
    aResult(t, 7) = Empty

Theo tôi, nên cho 2 dòng này ra khỏi vòng lặp J

 

[HUONGHCKT]

    For j = 1 To UBound(sArray, 2)
          aResult(t, j) = sArray(i, j)
          aResult(t, 6) = Empty
          aResult(t, 7) = Empty
...................................................
j=1 to 20, sẽ gán 20 lần:

    aResult(t, 6) = Empty
    aResult(t, 7) = Empty

Theo tôi, nên cho 2 dòng này ra khỏi vòng lặp J

Cảm ơn anh đã quan tâm và chỉ giáo.
Tôi thấy chủ thớt đính kèm file mà ở đó 2 cột (6 và 7)của sh kết quả không cần lấy dữ liệu và để trống do vậy qua mỗi vòng lặp tôi gán nó rỗng. Cách của anh thật là hiệu quả gán nó bằng rỗng ngay khi nạp dic. Thế là tôi đã học thêm được một tý kiến thức về Array nữa rồi. Trân trọng cảm ơn anh.