MinhKhai
Giải pháp Ếc-xào
- Tham gia
- 16/4/08
- Bài viết
- 941
- Được thích
- 574
Hy vọng đúng ý bạn.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
Góp thêm một cách cho bạn.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 !
Tôi thấy đoạ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ỏ
Cảm ơn anh đã xem bài.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)
10144514 | , HANG.BUIMINH@THAITAN.COM, OPS.IMPORT@ACSV.COM.VN |
Mình gửi bạn nhé.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é !
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êuCả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).
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.!
10144514, HANG.BUIMINH@THAITAN.COM, OPS.IMPORT@ACSV.COM.VN
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: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).
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.!
10144514, HANG.BUIMINH@THAITAN.COM, OPS.IMPORT@ACSV.COM.VN
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á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à đủ.Mình gửi bạn nhé.
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.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à đủ.
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ợ để muaCả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.
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.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
Tham khảo thêm 1 cáchChà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
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
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 ", ".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
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
Trường hợp bạn nếu đúng là tôi chủ quan không tính đến.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.
Đặ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: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:
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 ý.
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 đ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ứ
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.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?
.
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
Thử thay: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 ?
Mình thấy bạn cũng học code lâu rồi, có tìm hiểu về ADO, SQL rất nhiều mình nghĩ mấy cái này đâu khó gì với bạn đâuCó 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 ?
Mình dùng Excel nhưng chỉ dùng ở mức cơ bản thôi. Công việc hàng ngày cũng ít dùng Excel mà toàn thao tác trên phần mềm. Trước mình có hỏi về ADO, SQL là do các phần mềm đều dùng SQL Server database. Lấy được dữ liệu trực tiếp từ SQL Server ra Excel nên cảm thấy hứng thú và tự hào lắm. Hiện tại Excel phiên bản mới (Office 2019, Offce365) hỗ trợ lấy dữ liệu từ các nguồn database khá dễ dàng nên cũng lơ là ADO hơn.Mình thấy bạn cũng học code lâu rồi, có tìm hiểu về ADO, SQL rất nhiều mình nghĩ mấy cái này đâu khó gì với bạn đâu
Lỗi phần này thì mình sẽ chuyển nó về cùng dạng text, muốn làm điều đó thì theo code bạn @HUONGHCKT phần DK=Arr(i, 1) bạn sửa thành DK = CStr(Arr(i, 1))
Sửa: Nãy không thấy trả lời của bác @Phuocam![]()
Ý bác là lấy trường thời gian thay cho trường ID để pass qua vấn đề text hay number phải không ?1 máy quét 1 thời điểm chỉ có 1 ID => bài này có thể thống kê theo cột Time, => cùng 1 ID, dù là text hay number cũng ra kết quả như nhau
Nhờ bạn giải thích giúp cách khai báo t&, d&. Mình chưa thấy cách khai báo thế này bao giờSub NOI()
Dim Arr(), KQ(), DK, dic As Object
Dim i As Long, j As Long, t&, d&
- Mình lấy cả trường hợp ID không có Email để có thể kiểm tra vì một lý do nào đấy (có thể do lỗi, có thể do sót) còn có hướng khắc phục.Code của Hoàng Tuấn 868 đã xử lý theo tình huống giữ lại ID khi trường email rỗng,
Mình hiểu là t&,d& là kiểu varian, Còn Dim KQ(), Arr() là khai báo mảng chưa biết rõ kích thước, DK để trống thì được coi là mặc định Varian.Nhờ bạn giải thích giúp cách khai báo t&, d&. Mình chưa thấy cách khai báo thế này bao giờ
Ngoài ra việc khai báo dạng Dim Arr(), KQ(), DK, dic As Object thì Arr(), KQ(), DK, dic đều là Object à, thay vì: Dim Arr() As Object, KQ() As Object, DK As Object, dic As Object
t& là khai báo tắt của t As Long. Danh sách các kiểu biến có thể khai báo tắt như sau:Nhờ bạn giải thích giúp cách khai báo t&, d&. Mình chưa thấy cách khai báo thế này bao giờ
Ngoài ra việc khai báo dạng Dim Arr(), KQ(), DK, dic As Object thì Arr(), KQ(), DK, dic đều là Object à, thay vì: Dim Arr() As Object, KQ() As Object, DK As Object, dic As Object
Với dữ liệu trong file bài 1: 1 thời điểm chỉ có 1 ID => thống kê theo cột "ID" hay "Time"cái nào cũng ra kết quả như nhau cả thôi.Bài đã được tự động gộp:
Ý bác là lấy trường thời gian thay cho trường ID để pass qua vấn đề text hay number phải không ?
Sub GPE_hehehe()
Dim i&, k&, Data(), KetQua(), Dic As Object
On Error Resume Next
Data = Range(Sheets("Data").[A1], Sheets("Data").[A100000].End(3)).Resize(, 4)
ReDim KetQua(1 To UBound(Data), 1 To 3)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Data)
If Data(i, 2) <> Empty Then
If Not Dic.exists(CStr(Data(i, 1))) Then
k = k + 1
Dic(CStr(Data(i, 1))) = k
KetQua(k, 1) = Data(i, 1)
KetQua(k, 2) = Data(i, 2)
KetQua(k, 3) = Data(i, 3)
Else
KetQua(Dic.Item(CStr(Data(i, 1))), 2) = KetQua(Dic.Item(CStr(Data(i, 1))), 2) & "," & Data(i, 2)
End If
End If
Next
Sheets("KetQua").[A1].Resize(i - 1, 3) = KetQua
Sheets("KetQua").Activate
End Sub