Giúp em Lọc và gộp nhiều dữ liệu để tính Trung bình (1 người xem)

[phuongvq123]

Ý này nè bạn:

iD 301 sẽ có các ID nhánh gồm 21301, 22301, 23301, 24301, 25301, 26301, 10301 gộp thành 1 id 301 chưa thấy tác giả nói là nếu có 2 id 21301 thì gộp vào là 1 id 21301, nên tạm thời theo ý hiểu và kết quả điền tay của tác giả nên em thấy cách làm pivot hoặc công thức của chú bebo021999 đều được

 

[Nhattanktnn]

iD 301 sẽ có các ID nhánh gồm 21301, 22301, 23301, 24301, 25301, 26301, 10301 gộp thành 1 id 301 chưa thấy tác giả nói là nếu có 2 id 21301 thì gộp vào là 1 id 21301

Bạn xem bài #5 nhé, 3 số cuối lấy làm ID, do vậy nếu 2 ID 21301 thì nó cũng chung số đuôi 301 => Cùng nhóm

nên tạm thời theo ý hiểu và kết quả điền tay của tác giả nên em thấy cách làm pivot hoặc công thức của chú bebo021999 đều được

Thì mình có nói kết quả bác ấy không được đâu, nhưng chủ thớt muốn lọc từ sheet "chi tiết" ra làm báo cáo, mấy mã gõ tạm vào đó chỉ là mẫu mà thôi

Em muốn lọc từ Sheet "Chi tiết" nếu có các ID nhánh thì gộp thành 1 và đưa kết quả ra Sheet "Báo cáo"

 

[Cu Tồ]

Dữ liệu hơn 10.000 dòng, trong code trên sẽ có hơn 10.000 phép tính CHIA.
Thêm 1 vòng For ... Next chỉ còn K (khoảng 100) phép chia.

Option Explicit

Sub Bao_Cao()
Dim DL(), KQ()
Dim I As Long, K As Long, R As Long, Rws As Long
Dim Dic As Object
Dim ID As String
    Set Dic = CreateObject("scripting.dictionary")
With Sheet1
    DL = .Range("B3", .Range("B" & Rows.Count).End(xlUp)).Resize(, 2).Value
    R = UBound(DL)
ReDim KQ(1 To R, 1 To 4)
    For I = 1 To UBound(DL)
            ID = Right(Trim(DL(I, 1)), 3)
        If Not Dic.exists(ID) Then
                K = K + 1
            Dic.Item(ID) = K
            KQ(K, 1) = ID
        End If
            Rws = Dic.Item(ID)
            KQ(Rws, 2) = KQ(Rws, 2) + 1
            KQ(Rws, 3) = KQ(Rws, 3) + DL(I, 2)
    Next I
    For I = 1 To K
        KQ(I, 4) = KQ(I, 3) / KQ(I, 2)
    Next I
End With
    Set Dic = Nothing
With Sheet2
    .Range("B2").Resize(R, 4).ClearContents
    .Range("B2").Resize(K, 4) = KQ
    .Range("B2").Resize(K, 4).Sort Key1:=.Range("B2"), Order1:=xlAscending
End With
End Sub

Em cảm ơn bác. lúc đầu em tính chia ra làm 2 vòng mà sau lười quá nên thôi