ghép chuỗi trong dictionary

buonphatchan12 · 4/3/21

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

ptm0412 · 4/3/21

buonphatchan12 đã viết:
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

buonphatchan12 · 4/3/21

ptm0412 đã viết:
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

ptm0412 · 4/3/21

buonphatchan12 đã viết:
ý 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

buonphatchan12 · 4/3/21

ptm0412 đã viết:
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

truongvu317 · 4/3/21

buonphatchan12 đã viết:
cột N nếu tên giống nhau

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

buonphatchan12 · 4/3/21

truongvu317 đã viết:
truongvu317 đã viết:

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

Nhấp chuột vào đây để mở rộng...

truongvu317 đã viết:
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

batman1 · 4/3/21

buonphatchan12 đã viết:
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

Chính trong vấn đề này bạn đã mập mờ. Rõ ràng nếu xét "cả chuỗi trong ô" như bạn nói thì làm sao có thể lược bỏ 1 LAN CAN HÌNH CHỮ U được. Vì N2 rõ ràng khác N3 nếu xét "cả chuỗi trong ô". Cả 2 người đã viết rất rõ ràng nhưng hình như bạn không hiểu.

ptm0412 · 4/3/21

truongvu317 đã viết:
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ữ đỏ:

buonphatchan12 đã viết:
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.

buonphatchan12 · 4/3/21

batman1 đã viết:
Chính trong vấn đề này bạn đã mập mờ. Rõ ràng nếu xét "cả chuỗi trong ô" như bạn nói thì làm sao có thể lược bỏ 1 LAN CAN HÌNH CHỮ U được. Vì N2 rõ ràng khác N3 nếu xét "cả chuỗi trong ô". Cả 2 người đã viết rất rõ ràng nhưng hình như bạn không hiểu.

ptm0412 đã viết:
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ữ đỏ:

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 ạ

ptm0412 · 4/3/21

buonphatchan12 đã viết:
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

buonphatchan12 · 4/3/21

ptm0412 đã viết:
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

buonphatchan12 đã viết:
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 ạ

ptm0412 · 4/3/21

buonphatchan12 đã viết:
Đú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.

buonphatchan12 · 5/3/21

ptm0412 đã viết:
Bạn đưa dữ liệu mẫu vài trăm dòng lên đi, tôi không tạo đâu.

đây ban ơi, cám ơn bạn rất nhiều

Ba Tê · 5/3/21

buonphatchan12 đã viết:
đâ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

ptm0412 · 5/3/21

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

ptm0412 · 5/3/21

Ba Tê đã viết:
Bạn thử với Sub này

Code anh viết có nguy cơ bỏ qua đối với mặt hàng khác mã trùng tên. Việc tạo mã trùng tên thường xảy ra đối với người dùng cuối

Ba Tê · 5/3/21

ptm0412 đã viết:
Code anh viết có nguy cơ bỏ qua đối với mặt hàng khác mã trùng tên. Việc tạo mã trùng tên thường xảy ra đối với người dùng cuối

(Mã + Tên) là Txt2, sao sót được ta? ::?>>

ptm0412 · 5/3/21

Ba Tê đã viết:
(Mã + Tên) là Txt2, sao sót được ta?

À à, xin lỗi anh, tôi đọc vội Txt2 chỉ là tên

buonphatchan12 · 5/3/21

Ba Tê đã viết:
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

ptm0412 đã viết:

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

ghép chuỗi trong dictionary

Thành viên mới

Bad Excel Member

Thành viên mới

Bad Excel Member

Thành viên mới

Thành viên tích cực

Thành viên mới

Thành viên gạo cội

Bad Excel Member

Thành viên mới

Bad Excel Member

Thành viên mới

Bad Excel Member

Thành viên mới

File đính kèm

Cạo Rồi Khỏi Gội

Bad Excel Member

Bad Excel Member

Cạo Rồi Khỏi Gội

Bad Excel Member

Thành viên mới