Xin giúp đỡ về Code nối chuỗi có điều kiện không trùng lặp (1 người xem)

[duonghychi]

Mong các anh chị sửa giúp đoạn code nối chuỗi ạ, em cảm ơn!

Sub noichuoi()
    Dim r As Long, i As Long, a As Long, b As Long
    Dim Dict As Object
    Dim Item As String, dkien As Variant, chuoi As Variant
    Dim mangDieuKien As Variant, mangNoiChuoi As Variant
    a = Sheet3.Range("C" & Rows.Count).End(xlUp).Row
    dkien = Sheet3.Range("C10:C" & a).Value
    b = Sheet2.Range("D" & Rows.Count).End(xlUp).Row
    mangDieuKien = Sheet2.Range("D7:G" & b).Value
    ReDim chuoi(1 To UBound(dkien, 1), 1 To 1)
    For i = 1 To UBound(dkien, 1)
        Set Dict = CreateObject("Scripting.Dictionary")
        For r = 1 To UBound(mangDieuKien, 1)
            If mangDieuKien(r, 1) = dkien(i, 1) Then
                Item = mangDieuKien(r, 4)
                If Not Dict.Exists(Item) And Item > "" Then
                    Dict.Add Item, Empty
                    chuoi(i, 1) = Join(Dict.Keys, ", ")
                End If
            End If
        Next r
        Next i
    Sheet3.Range("L10").Resize(UBound(chuoi, 1), 1).Value = chuoi
End Sub

 

[CHAOQUAY]

Mong các anh chị sửa giúp đoạn code nối chuỗi ạ, em cảm ơn!

Sub noichuoi()
    Dim r As Long, i As Long
    Dim Dict As Object
    Dim Item As String, dkien, chuoi
    Dim mangDieuKien, mangNoiChuoi
   
        dkien = Sheet3.Range("c10:c" & Rows.Count).End(xlUp).Row.Value
        mangDieuKien = Sheet2.Range("d7:d" & Rows.Count).End(xlUp).Row.Value
        mangNoiChuoi = Sheet2.Range("g7:g" & Rows.Count).End(xlUp).Row.Value
   
        ReDim dkien(1 To 1, 1 To 1)
        ReDim mangDieuKien(1 To 1, 1 To 1)
        ReDim mangNoiChuoi(1 To 1, 1 To 1)
       
    For i = 1 To UBound(dkien)
    Set Dict = CreateObject("Scripting.Dictionary")
    For r = 1 To UBound(mangDieuKien)
        If mangDieuKien(r, 1) = dkien Then
            Item = mangNoiChuoi(r, 1)
            If Not Dict.Exists(Item) And Item > "" Then
                Dict.Add Item, Empty
            End If
        End If
    Next
    If Dict.Count Then
        chuoi(i, 1) = Join(Dict.Keys, ", ")
    End If
    Next i
    Sheet3.Range("L10").Resize(dkien, 1).Value = chuoi
End Sub

Code này bạn đã test chưa, kết quả thế nào

 

[VetMini]

Code này bạn đã test chưa, kết quả thế nào

Câu này tôi cũng tính hỏi.
Người ta có tật nhờ sửa sai giùm mà chẳng chịu cho biết sai ra sao? Chẳng hạn báo lỗi X ở dòng Y, hoặc đáng lẽ ra A mà lại ra B.

Đọc code thì có thể thấy chỗ sai, nhưng ai biết được chỗ sai ấy do giải thuật hay do viết code sai.