Nối dữ liệu có ID giống nhau thành 1 dòng

MinhKhai · 21/8/21

Chào các anh chị

Em có file dữ liệu như đính kèm. trong đó cột A là các ID được thể hiện thành nhiều dòng.
Nhờ các anh chị tạo cho đoạn code để gom các email tại cột B cùng ID vào 1 dòng

Xin chân thành cảm ơn !

Hoàng Tuấn 868 · 21/8/21

MinhKhai đã viết:
Chào các anh chị
Em có file dữ liệu như đính kèm. trong đó cột A là các ID được thể hiện thành nhiều dòng.
Nhờ các anh chị tạo cho đoạn code để gom các email tại cột B cùng ID vào 1 dòng
Xin chân thành cảm ơn !
View attachment 264445

Hy vọng đúng ý bạn.

MinhKhai · 21/8/21

Hoàng Tuấn 868 đã viết:
Hy vọng đúng ý bạn.

Cảm ơn bạn. Mình nhìn qua đã thấy đúng ý mình.
Tuy nhiên mình muốn dùng VBA xử lý hoàn toàn sau 1 nút bấm, không muốn tạo hàm UDF để rồi lại dùng hàm. Bạn chỉnh lại giúp nhé !

HUONGHCKT · 21/8/21

MinhKhai đã viết:
Chào các anh chị

Em có file dữ liệu như đính kèm. trong đó cột A là các ID được thể hiện thành nhiều dòng.
Nhờ các anh chị tạo cho đoạn code để gom các email tại cột B cùng ID vào 1 dòng

Xin chân thành cảm ơn !

Góp thêm một cách cho bạn.
hãy nhấn nút CHẠY CODE và xem kết quả trong các cột từ F2 đến H(n). nếu bạn muốn chỗ khác thì sửa dòng 2 dòng có .[F2].resize(.......) ở cuối Modul NOI_DIA_CHI nhé- Tôi tin là bạn làm được. Dữ liệu từ cột A đến cột E nếu muốn có thể xóa bỏ

Maika8008 · 21/8/21

HUONGHCKT đã viết:
Góp thêm một cách cho bạn.
hãy nhấn nút CHẠY CODE và xem kết quả trong các cột từ F2 đến H(n). nếu bạn muốn chỗ khác thì sửa dòng 2 dòng có .[F2].resize(.......) ở cuối Modul NOI_DIA_CHI nhé- Tôi tin là bạn làm được. Dữ liệu từ cột A đến cột E nếu muốn có thể xóa bỏ

Tôi thấy đoạn:
If KQ(j, 2) <> epmty Then KQ(j, 2) = KQ(j, 2) & "," & Arr(i, 2) Else KQ(j, 2) = Arr(i, 2)
phải đặt điều kiện Arr(i, 2) <> Epmty mới đúng chứ bạn tức là có email thì mới nối (tránh kết quả ra toàn dấu phẩy). Và theo tôi nếu không thỏa điều kiện thì không làm gì cả nên đâu cần Else KQ(j, 2) = Arr(i, 2)

HUONGHCKT · 21/8/21

Maika8008 đã viết:
Tôi thấy đoạn:
If KQ(j, 2) <> epmty Then KQ(j, 2) = KQ(j, 2) & "," & Arr(i, 2) Else KQ(j, 2) = Arr(i, 2)
phải đặt điều kiện Arr(i, 2) <> Epmty mới đúng chứ bạn tức là có email thì mới nối (tránh kết quả ra toàn dấu phẩy). Và theo tôi nếu không thỏa điều kiện thì không làm gì cả nên đâu cần Else KQ(j, 2) = Arr(i, 2)

Cảm ơn anh đã xem bài.
Tôi cũng đã thử rồi, nếu If Arr(i,2)<> empty then.... thì khi chay vẫn còn dấu "," do KQ(j,2)="", tiếp đến là dấu ", " , tiếp đến mới là Arr(i,2).

10144514

, HANG.BUIMINH@THAITAN.COM, OPS.IMPORT@ACSV.COM.VN

Và nếu vô hiệu Else KQ(j,2)=Arr(i,2) thì khi tìm thấy mã trùng sẽ KQ(j,2)= rỗng.!

Code tôi học mót còn có thiếu sót gì mong anh chị em xem qua chỉ giáo.
Trân trọng!

Hoàng Tuấn 868 · 21/8/21

MinhKhai đã viết:
Cảm ơn bạn. Mình nhìn qua đã thấy đúng ý mình.
Tuy nhiên mình muốn dùng VBA xử lý hoàn toàn sau 1 nút bấm, không muốn tạo hàm UDF để rồi lại dùng hàm. Bạn chỉnh lại giúp nhé !

Mình gửi bạn nhé.

Nhattanktnn · 21/8/21

HUONGHCKT đã viết:
Cảm ơn anh đã xem bài.
Tôi cũng đã thử rồi, nếu If Arr(i,2)<> empty then.... thì khi chay vẫn còn dấu "," do KQ(j,2)="", tiếp đến là dấu ", " , tiếp đến mới là Arr(i,2).

10144514
, HANG.BUIMINH@THAITAN.COM, OPS.IMPORT@ACSV.COM.VN

Và nếu vô hiệu Else KQ(j,2)=Arr(i,2) thì khi tìm thấy mã trùng sẽ KQ(j,2)= rỗng.!

Code tôi học mót còn có thiếu sót gì mong anh chị em xem qua chỉ giáo.
Trân trọng!

Ngay sau vòng for thêm if arr(i,2)<>"" luôn để không phải vào xét key đã tồn tại hay chưa, vừa đỡ thời gian xét dic, vừa tránh những lỗi mà bạn nêu

Maika8008 · 21/8/21

HUONGHCKT đã viết:
Cảm ơn anh đã xem bài.
Tôi cũng đã thử rồi, nếu If Arr(i,2)<> empty then.... thì khi chay vẫn còn dấu "," do KQ(j,2)="", tiếp đến là dấu ", " , tiếp đến mới là Arr(i,2).

10144514
, HANG.BUIMINH@THAITAN.COM, OPS.IMPORT@ACSV.COM.VN

Và nếu vô hiệu Else KQ(j,2)=Arr(i,2) thì khi tìm thấy mã trùng sẽ KQ(j,2)= rỗng.!

Code tôi học mót còn có thiếu sót gì mong anh chị em xem qua chỉ giáo.
Trân trọng!

Bạn là gì thì với trường hợp này cũng sẽ dư 1 dấu phẩy:

Với điều kiện của bạn thì kết quả sẽ là:
tram.ptn@asgl.vn,,HANG.BUIMINH@THAITAN.COM,OPS.IMPORT@ACSV.COM.VN

Vậy theo tôi nên dư dấu phẩy đàng sau thì hơn với điều kiện và cách nối: If Arr(i, 2) <> epmty Then KQ(j, 2) = KQ(j, 2) & Arr(i, 2) & ","
Nếu cần thiết thì xóa dấu phẩy sau khi chạy hết dữ liệu, còn như tôi nghĩ thì để nguyên cũng được.

Nhattanktnn · 21/8/21

Hoàng Tuấn 868 đã viết:
Mình gửi bạn nhé.

Bác @Hoàng Tuấn 868 nên xem lại giải thuật cho bài này, dùng dic thì chỉ cần 1 vòng for là đủ.

Hoàng Tuấn 868 · 21/8/21

Nhattanktnn đã viết:
Bác @Hoàng Tuấn 868 nên xem lại giải thuật cho bài này, dùng dic thì chỉ cần 1 vòng for là đủ.

Cảm ơn bạn, mình sẽ mò mẫm thêm, món này mình còn đang bỡ ngỡ lắm.

Nhattanktnn · 21/8/21

Hoàng Tuấn 868 đã viết:
Cảm ơn bạn, mình sẽ mò mẫm thêm, món này mình còn đang bỡ ngỡ lắm.

Trong lúc bác add key tạo item của key đó là số thứ tự k rồi. Thì khi kiểm tra key đã tồn tại thì chỉ cần lôi cái item của key đó ra (tức là số thứ tự k) rồi gán giá trị vào md(k,cột) = mn(i,cột) thôi bác. Còn hiện tại bác làm là như kiểu đi chợ, chạy quanh một vòng coi mặt hàng có không, có thì ghi mặt hàng đó vào sổ rồi chạy về nhà lấy tiền. Lấy tiền xong lại chạy ra chợ để mua

Hài hước tí thôi không có ý gì nhé bác

Hoàng Tuấn 868 · 21/8/21

Nhattanktnn đã viết:
Trong lúc bác add key tạo item của key đó là số thứ tự k rồi. Thì khi kiểm tra key đã tồn tại thì chỉ cần lôi cái item của key đó ra (tức là số thứ tự k) rồi gán giá trị vào md(k,cột) = mn(i,cột) thôi bác. Còn hiện tại bác làm là như kiểu đi chợ, chạy quanh một vòng coi mặt hàng có không, có thì ghi mặt hàng đó vào sổ rồi chạy về nhà lấy tiền. Lấy tiền xong lại chạy ra chợ để mua
Hài hước tí thôi không có ý gì nhé bác

Cũng phải cải tiến cách đi chợ thôi, giờ Covid cấm đi nhiều lần rồi.

CHAOQUAY · 21/8/21

MinhKhai đã viết:
Chào các anh chị

Em có file dữ liệu như đính kèm. trong đó cột A là các ID được thể hiện thành nhiều dòng.
Nhờ các anh chị tạo cho đoạn code để gom các email tại cột B cùng ID vào 1 dòng

Xin chân thành cảm ơn !

View attachment 264445

Tham khảo thêm 1 cách

Mã:

Option Explicit

Sub ghep()
Dim Nguon
Dim Tk
Dim h, m, s
Dim Kq
Dim i, j, k

With Sheet3
    Nguon = .Range("A2", .Range("C2").End(xlDown))
End With
ReDim Tk(24, 60, 60)
ReDim Kq(1 To UBound(Nguon), 1 To 3)
For i = 1 To UBound(Nguon)
    If Nguon(i, 2) <> "" Then
        h = Hour(Nguon(i, 3))
        m = Minute(Nguon(i, 3))
        s = Second(Nguon(i, 3))
        If Tk(h, m, s) = "" Then
            k = k + 1
            Tk(h, m, s) = k
            Kq(k, 1) = Nguon(i, 1)
            Kq(k, 3) = Nguon(i, 3)
            Kq(k, 2) = Nguon(i, 2)
        Else
            j = Tk(h, m, s)
            Kq(j, 2) = Kq(j, 2) & ", " & Nguon(i, 2)
        End If
    End If
Next i
Sheet3.Range("E2").Resize(k, 3) = Kq
End Sub

HUONGHCKT · 21/8/21

Nhattanktnn đã viết:
Ngay sau vòng for thêm if arr(i,2)<>"" luôn để không phải vào xét key đã tồn tại hay chưa, vừa đỡ thời gian xét dic, vừa tránh những lỗi mà bạn nêu

Cảm ơn bạn đã xem bài và chỉ giáo. Đúng là thêm điều kiện Arr(i,2)<> empty vào ngay sau vòng for i thì tránh được hết những lỗi thừa dấu ", ".
và code được sửa lại như sau:

Mã:

Sub NOI()
Dim Arr(), KQ(), DK, dic As Object
Dim i As Long, j As Long, t&, d&
With Sheets("Data")
d = .Cells(Rows.Count, 1).End(xlUp).Row
Arr = .Range("A2:C" & d).Value
ReDim KQ(1 To UBound(Arr), 1 To 4)
  Set dic = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(Arr)
If Arr(i, 2) <> Empty Then
     DK = Arr(i, 1)
    If Not dic.Exists(DK) Then
          t = t + 1: dic.Add DK, t
        KQ(t, 1) = t: KQ(t, 2) = DK: KQ(t, 3) = Arr(i, 2): KQ(t, 4) = Arr(i, 3)
    Else
        j = dic.Item(DK)
        KQ(j, 3) = KQ(j, 3) & ", " & Arr(i, 2)
    End If
End If
Next i
If t Then
    .[F2].Resize(UBound(Arr), 4).ClearContents
    .[F2].Resize(t, 4) = KQ
End If
End With
Set dic = Nothing
End Sub

Bài đã được tự động gộp: 21/8/21

Maika8008 đã viết:
Bạn là gì thì với trường hợp này cũng sẽ dư 1 dấu phẩy:
View attachment 264453
Với điều kiện của bạn thì kết quả sẽ là:
tram.ptn@asgl.vn,,HANG.BUIMINH@THAITAN.COM,OPS.IMPORT@ACSV.COM.VN

Vậy theo tôi nên dư dấu phẩy đàng sau thì hơn với điều kiện và cách nối: If Arr(i, 2) <> epmty Then KQ(j, 2) = KQ(j, 2) & Arr(i, 2) & ","
Nếu cần thiết thì xóa dấu phẩy sau khi chạy hết dữ liệu, còn như tôi nghĩ thì để nguyên cũng được.

Trường hợp bạn nếu đúng là tôi chủ quan không tính đến.
Tôi đã sửa lại theo góp ý của bạn @Nhattanktnn thêm If arr(i,2)<> empty then ... vào ngay sau vòng lặp For là giải quyết được các lỗi thừa dấu " ," rồi, nó cũng tiết kiệm được thời gian kiểm tra dic(DK) đã tồn tại hay chưa==> tốc độ được cải thiện.
Một lần nữa trân trọng cảm ơn các bạn đã góp ý.

Maika8008 · 21/8/21

HUONGHCKT đã viết:
Cảm ơn bạn đã xem bài và chỉ giáo. Đúng là thêm điều kiện Arr(i,2)<> empty vào ngay sau vòng for i thì tránh được hết những lỗi thừa dấu ", ".
và code được sửa lại như sau:

Mã:

Sub NOI() Dim Arr(), KQ(), DK, dic As Object Dim i As Long, j As Long, t&, d& With Sheets("Data") d = .Cells(Rows.Count, 1).End(xlUp).Row Arr = .Range("A2:C" & d).Value ReDim KQ(1 To UBound(Arr), 1 To 4) Set dic = CreateObject("Scripting.Dictionary") For i = 1 To UBound(Arr) If Arr(i, 2) <> Empty Then DK = Arr(i, 1) If Not dic.Exists(DK) Then t = t + 1: dic.Add DK, t KQ(t, 1) = t: KQ(t, 2) = DK: KQ(t, 3) = Arr(i, 2): KQ(t, 4) = Arr(i, 3) Else j = dic.Item(DK) KQ(j, 3) = KQ(j, 3) & ", " & Arr(i, 2) End If End If Next i If t Then .[F2].Resize(UBound(Arr), 4).ClearContents .[F2].Resize(t, 4) = KQ End If End With Set dic = Nothing End Sub

Bài đã được tự động gộp: 21/8/21

Trường hợp bạn nếu đúng là tôi chủ quan không tính đến.
Tôi đã sửa lại theo góp ý của bạn @Nhattanktnn thêm If arr(i,2)<> empty then ... vào ngay sau vòng lặp For là giải quyết được các lỗi thừa dấu " ," rồi, nó cũng tiết kiệm được thời gian kiểm tra dic(DK) đã tồn tại hay chưa==> tốc độ được cải thiện.
Một lần nữa trân trọng cảm ơn các bạn đã góp ý.

Đặt điều kiện ở đó (và như code của bạn) là không được đâu bạn ơi. Với trường hợp thế này:

thì ID của hai dòng đầu sẽ bị bỏ qua, mà lẽ ra phải có kết quả và Email = Empty kia chứ

Phuocam · 21/8/21

Maika8008 đã viết:
Đặt điều kiện ở đó (và như code của bạn) là không được đâu bạn ơi. Với trường hợp thế này:

thì ID của hai dòng đầu sẽ bị bỏ qua, mà lẽ ra phải có kết quả và Email = Empty kia chứ

Sao không chờ phản hồi của người hỏi (OP) ? Biết đâu người ta bỏ qua khi email có giá trị là rỗng?

.

Maika8008 · 21/8/21

Phuocam đã viết:
Sao không chờ phản hồi của người hỏi (OP) ? Biết đâu người ta bỏ qua khi email có giá trị là rỗng?

.

Tất nhiên nếu người dùng không cần thì ta không bàn đến nhưng ở đây đang nói đến chuyện lường hết các trường hợp có thể xảy ra khi lập trình thôi.

@HUONGHCKT
Theo tôi thì chỗ Else của bài #4 viết lại thế này là ổn

Rich (BB code):

        j = dic.Item(DK)
        If Arr(i, 2) <> epmty Then
            If KQ(j, 2) = Empty Then
                KQ(j, 2) = Arr(i, 2)
            Else
                KQ(j, 2) = KQ(j, 2) & "," & Arr(i, 2)
            End If
        End If

Dài ra tí nhưng dễ hiểu và có kết quả đúng

MinhKhai · 22/8/21

Chào các anh chị
Trước hết xin được cảm ơn các anh chị đã giúp đỡ. Tất cả các hỗ trợ của anh chị phía trên đều đã đáp ứng yêu cầu của mình. Code không chỉ chạy đúng yêu cầu mà còn chạy rất mượt dù mình đã thử tăng dữ liệu gấp vài lần như thế.
File ban đầu của bạn @HUONGHCKT đúng là có thừa dấu phân cách nhưng sau đó vấn đề này đã được xử lý. Khi dữ liệu không có email để ghép, phần kết quả không list ra. Cách này cũng là mong muốn của mình. Giúp đỡ của bác @Hoàng Tuấn 868 thì khi vùng dữ liệu gốc bị trống dòng nào đó, kết quả vẫn ra dòng 1 trống. Cách này cũng hữu ích khi mình cần rà roát dữ liệu.
Code của bạn @CHAOQUAY mình thử thì ra kết quả có 1 dòng. Có lẽ mình làm sai gì đó.
Có 1 tình huống nhỏ là nếu cột ID bị tác động, kiểu dữ liệu đang là text chuyển sang là number lúc này code nhận thành 2 ID khác nhau. Các anh chị có thể bẫy lỗi phần này được không ?
Cảm ơn bạn @Maika8008 @Nhattanktnn và @Phuocam nhiều nhé.

tranhungdao12a3 · 22/8/21

Bài này hình như chỉ cần 1 dòng này là ra kết quả rồi:
Ghepmail2:=CONCATENATEX(SUMMARIZE('Table1', 'Table1'[ID],),[Email],", ")
Chủ thớt tham khảo nhé!

Nối dữ liệu có ID giống nhau thành 1 dòng

Giải pháp Ếc-xào

File đính kèm

Đăng ký hôm qua

File đính kèm

Giải pháp Ếc-xào

Zalo 0986997214

File đính kèm

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

Zalo 0986997214

Đăng ký hôm qua

File đính kèm

Thành viên gắn bó

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

Thành viên gắn bó

Đăng ký hôm qua

Thành viên gắn bó

Đăng ký hôm qua

Thành viên gắn bó

Zalo 0986997214

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

Thành viên mới

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

Giải pháp Ếc-xào

Thành viên tiêu biểu