Xin nhờ giúp đỡ: dò tìm dựa vào bảng mã nhóm khác

[hmgiang2009]

Dạ em xin chào các anh/chị ạ, xin anh/chị dành chút thời gian giúp đỡ em với ạ
em có bảng dữ liệu tại sheet 2023: trong đó có cột I, BI, EH. Tại sheet 1 em đã nhóm lại tất cả các mã (tại cột D) theo yêu cầu ở sheet 08, giờ em muốn tổng hợp lại dựa vào bảng dò đó, em xin anh chỉ giáo e với ạ
- Em xin đính kèm file, em xin cảm ơn rất nhiều

 

[HUONGHCKT]

Dạ em xin chào các anh/chị ạ, xin anh/chị dành chút thời gian giúp đỡ em với ạ
em có bảng dữ liệu tại sheet 2023: trong đó có cột I, BI, EH. Tại sheet 1 em đã nhóm lại tất cả các mã (tại cột D) theo yêu cầu ở sheet 08, giờ em muốn tổng hợp lại dựa vào bảng dò đó, em xin anh chỉ giáo e với ạ
- Em xin đính kèm file, em xin cảm ơn rất nhiều

Tham khảo code sau:

Option Explicit
Sub ABC()
Dim i&, j&, Lr&, t&, k&, Tong&
Dim Arr(), Data(), KQ(), SName(1 To 6)
Dim Dic As Object, Key
Dim Sh As Worksheet, Ws As Worksheet
Set Sh = Sheets("sheet1")
Lr = Sh.Cells(1000000, 1).End(xlUp).Row
Arr = Sh.Range("A2:D" & Lr).Value
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
    Key = Arr(i, 4)
        If Not Dic.Exists(Key) Then
            t = t + 1: Dic.Add (Key), t: Dic(Key) = Arr(i, 1)
        Else
            Dic(Key) = Dic(Key) & "," & Arr(i, 1)
        End If
Next i

Set Ws = Sheets("2023")
Lr = Ws.Cells(1000000, 9).End(xlUp).Row
Data = Ws.Range("I6:EH" & Lr).Value
ReDim KQ(1 To Dic.count, 1 To 2)
For i = 1 To UBound(Data)
    If Data(i, 130) <> Empty Then
        For Each Key In Dic.keys
            k = --Key
            If InStr(1, Dic(Key), Data(i, 130)) Then
                SName(k) = SName(k) + 1
                KQ(k, 1) = SName(k)
                KQ(k, 2) = KQ(k, 2) + Data(i, 53)
            End If
        Next Key
    End If
Next i
With Sheets("08")
    .Range("C3").Resize(6, 2).ClearContents
    .Range("C3").Resize(6, 2) = KQ
End With
Set Dic = Nothing
MsgBox "Done"
End Sub

Nhấn nút Run code trong file đính kèm để xem kết quả.
Lưu ý lần sau không nên viết tắt.

 

[TongDe]

Đang nghi ngờ kết quả của Query thì vớ được code này để kiểm tra...
Dic quả lợi hại...