Nhờ giúp đỡ code nhóm dữ liệu theo điều kiện

Chia sẻ bởi:hands

★★★★★

‹ CẦN RÚT GỌN CÔNG THỨC LƯU FILE bị trùng tên với file... ›

Quảng cáo

Xin chào anh/chị
Do máy công ty đang dùng office 2010 không dùng được hàm mới, nên nhờ anh/chị giúp dùm code nối dữ liệu khi trùng mã STT.
kết quả mong muốn như phía dưới, xin chan thành cảm ơn anh/chị.
1119

Function MaKH(SoTT As String, CSDL As Range)
Const FC As String = "\"
Dim J As Long, Rws As Integer

Rws = CSDL.Rows.Count
For J = 1 To Rws + 3
If Cells(J, 1).Value = SoTT Then
MaKH = Cells(J, 3).Value & FC & MaKH
End If
Next J
MaKH = Left(MaKH, Len(MaKH) – 2)
End Function

www.giaiphapexcel.com/diendan/threads/nh%E1%BB%9D-gi%C3%BAp-%C4%91%E1%BB%A1-code-nh%C3%B3m-d%E1%BB%AF-li%E1%BB%87u-theo-%C4%91i%E1%BB%81u-ki%E1%BB%87n.163687/post-1091919

Em cám ơn anh nhiều ạ!

Bạn sử dụng code sau và kiểm tra lại kết quả nhé!

Sub Gop_DL()
    Dim Lr&, i&, Arr(), Res(1 To 10000, 1 To 3)
    Dim Dic As Object, Key$, k&
    Set Dic = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    With Sheets("Sheet1")
        .Range("H4:J10000").ClearContents
        Lr = .Range("A" & Rows.Count).End(xlUp).Row
        Arr = .Range("A4:C" & Lr).Value
        For i = 1 To UBound(Arr)
            Key = Arr(i, 1)
            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, 3)
            Else
                Res(Dic.Item(Key), 3) = Res(Dic.Item(Key), 3) & "//" & Arr(i, 3)
            End If
        Next i
        .Range("H4").Resize(k, 3).Value = Res
    End With
    Set Dic = Nothing
End Sub

www.giaiphapexcel.com/diendan/threads/nh%E1%BB%9D-gi%C3%BAp-%C4%91%E1%BB%A1-code-nh%C3%B3m-d%E1%BB%AF-li%E1%BB%87u-theo-%C4%91i%E1%BB%81u-ki%E1%BB%87n.163687/post-1091960