ghép chuỗi trong dictionary

Liên hệ QC

buonphatchan12

Thành viên mới
Tham gia
21/10/20
Bài viết
35
Được thích
1
bbbbbbbbbbb.PNG

Xin chào mọi người, mình có vấn đề muố hỏi là: làm cách nào để nối chuỗi trong dictionary vba
Như trong ảnh là cột C có những mã giống nhau có tên là cột N có mã có thể không giống nhau, thì phần kết quả sẽ là combine tên ở cột N lại với nhau và không trùng
VD như là: mà N20-3142 có 3 tên LAN CAN HÌNH CHỮ U,LAN CAN HÌNH CHỮ U, GIÁ CÀ CHUA thì kết quả cho ra sẽ là LAN CAN HÌNH CHỮ U, GIÁ CÀ CHUA 1 cái tên LAN CAN HÌNH CHỮ U được lược bỏ. Mình dùng dictionary những k tách được tên trùng thì được lược bỏ đi. Mong m.n giúp đỡ mình! Cám ơn m.n
 
VD như là: mà N20-3142 có 3 tên LAN CAN HÌNH CHỮ U, LAN CAN HÌNH CHỮ U, GIÁ CÀ CHUA thì kết quả cho ra sẽ là LAN CAN HÌNH CHỮ U, GIÁ CÀ CHUA 1 cái tên LAN CAN HÌNH CHỮ U được lược bỏ.
Hai cái LAN CAN HÌNH CHỮ U xét về toàn bộ text (bao gồm chữ con sâu) là khác nhau nhé.
Giả sử mảng SArray là từ A đến N:
Dict.Add SArray(i, 3) & SArray(i, 14), k
 
Upvote 0
Hai cái LAN CAN HÌNH CHỮ U xét về toàn bộ text (bao gồm chữ con sâu) là khác nhau nhé.
Giả sử mảng SArray là từ A đến N:
Dict.Add SArray(i, 3) & SArray(i, 14), k
ý mình kết quả trả về sẽ phải là trong 1 dòng: VD: LAN CAN HÌNH CHỮ U & " " & GIÁ CÀ CHUA. Thì phần trả về dic.item sẽ là ntn vậy
 
Upvote 0
ý mình kết quả trả về sẽ phải là trong 1 dòng: VD: LAN CAN HÌNH CHỮ U & " " & GIÁ CÀ CHUA. Thì phần trả về dic.item sẽ là ntn vậy
Bạn đọc thật kỹ và thật chậm:
xét
toàn
bộ
text

Nếu bỏ qua chữ con sâu hay bỏ qua cái gì khác thì bạn phải nói ra quy luật
 
Upvote 0
Bạn đọc thật kỹ và thật chậm:
xét
toàn
bộ
text

Nếu bỏ qua chữ con sâu hay bỏ qua cái gì khác thì bạn phải nói ra quy luật
xin lỗi mình k nói rõ, nghĩa là kí tự ở bên cột A sẽ lấy duy nhất theo dictionary, sang bên cột N nếu tên giống nhau thì chỉ lấy duy nhất, nếu khác nhau thì nối tên lạ với nhau. VD mã N20-3142 có 4 tên bên cột N lần lượt là A1,A2,A1,A3 thì giá trị trả về sẽ chỉ là A1 & " " & A2 & " " & A3. Cám ơn bạn rất nhiều


1.PNG
 
Upvote 0
giống nhau khi chỉ xét phần chữ tiếng việt, hay tính cả phần chữ "s

giống nhau khi chỉ xét phần chữ tiếng việt, hay tính cả phần chữ "sâu".
xét cả chuỗi trong ô đó, mình làm k bỏ được giống nhau đó, bạn có thể chỉ giúp mìh được k ạ, mình cảm ơn
 
Upvote 0
xét cả chuỗi trong ô đó, mình làm k bỏ được giống nhau đó, bạn có thể chỉ giúp mìh được k ạ, mình cảm ơn
Chính trong vấn đề này bạn đã mập mờ. Rõ ràng nếu xét "cả chuỗi trong ô" như bạn nói thì làm sao có thể lược bỏ 1 LAN CAN HÌNH CHỮ U được. Vì N2 rõ ràng khác N3 nếu xét "cả chuỗi trong ô". Cả 2 người đã viết rất rõ ràng nhưng hình như bạn không hiểu.
 
Upvote 0
giống nhau khi chỉ xét phần chữ tiếng việt, hay tính cả phần chữ "sâu".
Dòng 2 và dòng 3 trong hình bài 1 không chỉ khác nhau chữ con sâu, mà dòng 2 còn có 1 chữ U sát sâu mà dòng 3 không có. Nếu chỉ loại bỏ chữ con sâu thì vẫn cứ là khác nhau và theo phần trích chữ đỏ:
bên cột N nếu tên giống nhau thì chỉ lấy duy nhất, nếu khác nhau thì nối tên lại với nhau.
 
Upvote 0
Chính trong vấn đề này bạn đã mập mờ. Rõ ràng nếu xét "cả chuỗi trong ô" như bạn nói thì làm sao có thể lược bỏ 1 LAN CAN HÌNH CHỮ U được. Vì N2 rõ ràng khác N3 nếu xét "cả chuỗi trong ô". Cả 2 người đã viết rất rõ ràng nhưng hình như bạn không hiểu.
Dòng 2 và dòng 3 trong hình bài 1 không chỉ khác nhau chữ con sâu, mà dòng 2 còn có 1 chữ U sát sâu mà dòng 3 không có. Nếu chỉ loại bỏ chữ con sâu thì vẫn cứ là khác nhau và theo phần trích chữ đỏ:
1.PNG
Dạ. Mình đã lấy ví dụ ở bên trên cho dễ hiểu rồi đây ạ, kết quả mình cần là cột D và cột E dữ liệu lấy từ cột A và B. Mình là được những phải làm qua 2 bước đó là remove duplicates cả 2 cột A và B, sau đó ghép cột B lại với nhau thì ra được kết quả mình mong muốn, mình muốn hỏi có cách nào tiện lợi hơn k ạ. Thanks nhiều ạ
 
Upvote 0
View attachment 254869
Dạ. Mình đã lấy ví dụ ở bên trên cho dễ hiểu rồi đây ạ, kết quả mình cần là cột D và cột E dữ liệu lấy từ cột A và B. Mình là được những phải làm qua 2 bước đó là remove duplicates cả 2 cột A và B, sau đó ghép cột B lại với nhau thì ra được kết quả mình mong muốn, mình muốn hỏi có cách nào tiện lợi hơn k ạ. Thanks nhiều ạ
Tôi làm xong vẫn sẽ ra A1A2A1aA3 vì bản chất đằng sau A1 dòng 1 và A1 dòng 3 không giống nhau.
Và tôi bảo đảm rằng file có hình ở bài 1 có remove duplicate kiểu gì thì dòng 2 và 3 vẫn cứ tồn tại cùng lúc
 
Upvote 0
Tôi làm xong vẫn sẽ ra A1A2A1aA3 vì bản chất đằng sau A1 dòng 1 và A1 dòng 3 không giống nhau.
Và tôi bảo đảm rằng file có hình ở bài 1 có remove duplicate kiểu gì thì dòng 2 và 3 vẫn cứ tồn tại cùng lúc
Đúng có thể lúc mình post bài nó bị sai, mình đã sửa lại thành như vậy rồi, đề bài A1 ở dòng 1 và A1 ở dòng 3 giống y hệt nhau k khác gì. Thì làm cách nào ghép đc thành A1 & A2 & A3. Mình post sai chút mong b thông cảm, mình cần lấy kết quả như hình ạ. Cám ơn nhiều
View attachment 254869
Dạ. Mình đã lấy ví dụ ở bên trên cho dễ hiểu rồi đây ạ, kết quả mình cần là cột D và cột E dữ liệu lấy từ cột A và B. Mình là được những phải làm qua 2 bước đó là remove duplicates cả 2 cột A và B, sau đó ghép cột B lại với nhau thì ra được kết quả mình mong muốn, mình muốn hỏi có cách nào tiện lợi hơn k ạ. Thanks nhiều ạ
 
Upvote 0
Đúng có thể lúc mình post bài nó bị sai, mình đã sửa lại thành như vậy rồi, đề bài A1 ở dòng 1 và A1 ở dòng 3 giống y hệt nhau k khác gì. Thì làm cách nào ghép đc thành A1 & A2 & A3. Mình post sai chút mong b thông cảm, mình cần lấy kết quả như hình ạ. Cám ơn nhiều
Bạn đưa dữ liệu mẫu vài trăm dòng lên đi, tôi không tạo đâu.
 
Upvote 0
đây ban ơi, cám ơn bạn rất nhiều
Bạn đừng viết tắt "b, k, m.n, ... " nhé, vì mọi người không hiểu bạn muốn viết gì đâu.
Với lại muốn nhờ người khác viết code hàng ngàn chữ mà chỉ vài chữ bạn cũng "làm biếng" gõ phím thì không "đẹp" lắm.
Bạn thử với Sub này với file bạn gởi ở bài #14 xem sao:
PHP:
Option Explicit

Public Sub Gpe()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Rws As Long, Txt1 As String, Txt2 As String
    sArr = Range("A1", Range("A1").End(xlDown)).Resize(, 2).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 2)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R
        Txt1 = sArr(I, 1)
        Txt2 = Txt1 & sArr(I, 2)
        If Not .Exists(Txt1) Then
            K = K + 1
            .Item(Txt1) = K
            .Item(Txt2) = ""
            dArr(K, 1) = Txt1
            dArr(K, 2) = sArr(I, 2)
        Else
            Rws = .Item(Txt1)
            If Not .Exists(Txt2) Then
                .Item(Txt2) = ""
                dArr(Rws, 2) = dArr(Rws, 2) & " --- " & sArr(I, 2)
            End If
        End If
    Next I
End With
    Range("D1").Resize(1000, 2).ClearContents
    Range("D1").Resize(K, 2) = dArr
End Sub
 
Upvote 0
Nếu nói chính xác và có file ngay từ bài 1 thì đã xong từ lâu
PHP:
Sub JoinName()
Dim Dict, SArr(), RArr()
Dim LastRw As Long, k As Long, i As Long, m As Long
LastRw = Sheet1.[A10000].End(xlUp).Row
SArr = Sheet1.Range("A2:B" & LastRw).Value2
ReDim RArr(1 To LastRw, 1 To 2)
Set Dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(SArr, 1)
    If Not Dict.exists(SArr(i, 1)) Then
        k = k + 1
        Dict.Add SArr(i, 1), k
        RArr(k, 1) = SArr(i, 1)
        RArr(k, 2) = SArr(i, 2)
    Else
        m = Dict.Item(SArr(i, 1))
        If InStr(1, RArr(m, 2), SArr(i, 2)) = 0 Then
            RArr(m, 2) = RArr(m, 2) & ";" & SArr(i, 2)
        End If
    End If
Next
Sheet1.Range("E2:F10000").ClearContents
Sheet1.[E2].Resize(k, 2).Value = RArr
End Sub
 
Upvote 0
Bạn đừng viết tắt "b, k, m.n, ... " nhé, vì mọi người không hiểu bạn muốn viết gì đâu.
Với lại muốn nhờ người khác viết code hàng ngàn chữ mà chỉ vài chữ bạn cũng "làm biếng" gõ phím thì không "đẹp" lắm.
Bạn thử với Sub này với file bạn gởi ở bài #14 xem sao:
PHP:
Option Explicit

Public Sub Gpe()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Rws As Long, Txt1 As String, Txt2 As String
    sArr = Range("A1", Range("A1").End(xlDown)).Resize(, 2).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 2)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R
        Txt1 = sArr(I, 1)
        Txt2 = Txt1 & sArr(I, 2)
        If Not .Exists(Txt1) Then
            K = K + 1
            .Item(Txt1) = K
            .Item(Txt2) = ""
            dArr(K, 1) = Txt1
            dArr(K, 2) = sArr(I, 2)
        Else
            Rws = .Item(Txt1)
            If Not .Exists(Txt2) Then
                .Item(Txt2) = ""
                dArr(Rws, 2) = dArr(Rws, 2) & " --- " & sArr(I, 2)
            End If
        End If
    Next I
End With
    Range("D1").Resize(1000, 2).ClearContents
    Range("D1").Resize(K, 2) = dArr
End Sub
Nếu nói chính xác và có file ngay từ bài 1 thì đã xong từ lâu
PHP:
Sub JoinName()
Dim Dict, SArr(), RArr()
Dim LastRw As Long, k As Long, i As Long, m As Long
LastRw = Sheet1.[A10000].End(xlUp).Row
SArr = Sheet1.Range("A2:B" & LastRw).Value2
ReDim RArr(1 To LastRw, 1 To 2)
Set Dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(SArr, 1)
    If Not Dict.exists(SArr(i, 1)) Then
        k = k + 1
        Dict.Add SArr(i, 1), k
        RArr(k, 1) = SArr(i, 1)
        RArr(k, 2) = SArr(i, 2)
    Else
        m = Dict.Item(SArr(i, 1))
        If InStr(1, RArr(m, 2), SArr(i, 2)) = 0 Then
            RArr(m, 2) = RArr(m, 2) & ";" & SArr(i, 2)
        End If
    End If
Next
Sheet1.Range("E2:F10000").ClearContents
Sheet1.[E2].Resize(k, 2).Value = RArr
End Sub
Cám ơn hai bác rất nhiều, mình sẽ rút kinh nghiệm ạ. Mình áp dụng xem sao. Thanks
 
Upvote 0
Web KT
Back
Top Bottom