Nhò các cao nhân giúp xóa dữ liệu trùng lặp trong 1 ô cells

[nguyenhuuhieu94dha]

Tôi sử dụng hàm vlookup để tìm dữ liệu thì xuất hiện 2 lần " '+ Tổ chức thi công: TCVN 4055:2012". Nhờ các cao nhân giúp hàm xóa bớt dữ liệu trùng lặp như ảnh trên

 

[HUONGHCKT]

Tôi sử dụng hàm vlookup để tìm dữ liệu thì xuất hiện 2 lần " '+ Tổ chức thi công: TCVN 4055:2012". Nhờ các cao nhân giúp hàm xóa bớt dữ liệu trùng lặp như ảnh trên

nếu còn quan tâm thì thử hàm UDF này xem sao, hy vọng đáp ứng được yêu cầu đề bài
cấu trúc hàm: =XoaKT(ô cần xóa chuỗi trùng) và Enter
Trong hàm đã loại trừ các dấu: ", . : - + ; rồi

Function XoaKT(Target As Range)
Dim S, t&, k&, z&, Dic As Object
Dim Temp, Tmp, KQ()
Dim WF As Object
Set Dic = CreateObject("Scripting.Dictionary")
Set WF = Application.WorksheetFunction
On Error Resume Next
    Temp = Trim(Target)
k = Len(Trim(Temp))
    Tmp = WF.Substitute(Temp, ", ", "\")
    Tmp = WF.Substitute(Tmp, ". ", "\")
    Tmp = WF.Substitute(Tmp, ": ", "\")
    Tmp = WF.Substitute(Tmp, "; ", "\")
    Tmp = WF.Substitute(Tmp, " +", "\")
    Tmp = WF.Substitute(Tmp, " -", "\")
t = Len(Tmp) - 1
S = Split(Trim(Tmp), "\")
ReDim KQ(1 To 1)
For i = 1 To k - t
    If Not Dic.Exists(S(i)) Then
        z = z + 1
        Dic.Add (S(i)), z
        KQ(1) = KQ(1) & " +" & S(i)
    End If
Next i
XoaKT = KQ
Set Dic = Nothing
End Function

tự tôi cảm thấy UDF này vẫn còn lòng thòng, vòng vèo và cũng không tính được hết các trường hợp khác nữa, mà không biết làm thế nào. Hy vọng được các anh chị em trên diễn đàn ghé qua đọc và cho góp ý để hoàn thiện hơn

 

[HieuCD]

nếu còn quan tâm thì thử hàm UDF này xem sao, hy vọng đáp ứng được yêu cầu đề bài
cấu trúc hàm: =XoaKT(ô cần xóa chuỗi trùng) và Enter
Trong hàm đã loại trừ các dấu: ", . : - + ; rồi

Function XoaKT(Target As Range)
Dim S, t&, k&, z&, Dic As Object
Dim Temp, Tmp, KQ()
Dim WF As Object
Set Dic = CreateObject("Scripting.Dictionary")
Set WF = Application.WorksheetFunction
On Error Resume Next
    Temp = Trim(Target)
k = Len(Trim(Temp))
    Tmp = WF.Substitute(Temp, ", ", "\")
    Tmp = WF.Substitute(Tmp, ". ", "\")
    Tmp = WF.Substitute(Tmp, ": ", "\")
    Tmp = WF.Substitute(Tmp, "; ", "\")
    Tmp = WF.Substitute(Tmp, " +", "\")
    Tmp = WF.Substitute(Tmp, " -", "\")
t = Len(Tmp) - 1
S = Split(Trim(Tmp), "\")
ReDim KQ(1 To 1)
For i = 1 To k - t
    If Not Dic.Exists(S(i)) Then
        z = z + 1
        Dic.Add (S(i)), z
        KQ(1) = KQ(1) & " +" & S(i)
    End If
Next i
XoaKT = KQ
Set Dic = Nothing
End Function

tự tôi cảm thấy UDF này vẫn còn lòng thòng, vòng vèo và cũng không tính được hết các trường hợp khác nữa, mà không biết làm thế nào. Hy vọng được các anh chị em trên diễn đàn ghé qua đọc và cho góp ý để hoàn thiện hơn

Bạn nên tìm cách bỏ lệnh On Error Resume Next
Dùng hàm replace của VBA
Bỏ biến k, t, Z, KQ
Dùng lệnh Join(Dic.keys, "+ ")

 

[HUONGHCKT]

Bạn nên tìm cách bỏ lệnh On Error Resume Next
Dùng hàm replace của VBA
Bỏ biến k, t, Z, KQ
Dùng lệnh Join(Dic.keys, "+ ")

Cảm ơn anh đã ghé xem bài. Thực tình tôi chưa có hiểu biết gì về Join. Còn Dic thì cũng chỉ là học mót, chắp vá từ diễn đàn.
Nếu có thể Anh sửa lại hàm UDF trên bằng Join, để tôi được học thêm một chút nữa về Join nói riêng và VBA nói chung

 

[HieuCD]

Cảm ơn anh đã ghé xem bài. Thực tình tôi chưa có hiểu biết gì về Join. Còn Dic thì cũng chỉ là học mót, chắp vá từ diễn đàn.
Nếu có thể Anh sửa lại hàm UDF trên bằng Join, để tôi được học thêm một chút nữa về Join nói riêng và VBA nói chung

Xem code

Function XoaKT(Target As Range) As String
  Dim S, spChar, Dic As Object, tmp$, res$, i&

  Set Dic = CreateObject("Scripting.Dictionary")
  spChar = Array(",", ".", ":", ";", "+", "-")
  tmp = Trim(Target)
  For i = 0 To UBound(spChar)
    tmp = Replace(tmp, spChar(i), "|")
  Next i
  S = Split(tmp, "|")
  For i = 0 To UBound(S)
    tmp = Trim(S(i))
    If tmp <> Empty Then Dic.Item(tmp) = ""
  Next i
  XoaKT = "+ " & Join(Dic.keys, "+ ")
  Set Dic = Nothing
End Function

 

[nguyenhuuhieu94dha]

Xem code

Function XoaKT(Target As Range) As String
  Dim S, spChar, Dic As Object, tmp$, res$, i&

  Set Dic = CreateObject("Scripting.Dictionary")
  spChar = Array(",", ".", ":", ";", "+", "-")
  tmp = Trim(Target)
  For i = 0 To UBound(spChar)
    tmp = Replace(tmp, spChar(i), "|")
  Next i
  S = Split(tmp, "|")
  For i = 0 To UBound(S)
    tmp = Trim(S(i))
    If tmp <> Empty Then Dic.Item(tmp) = ""
  Next i
  XoaKT = "+ " & Join(Dic.keys, "+ ")
  Set Dic = Nothing
End Function

Cảm ơn bạn rất nhiều. Code này dùng rất tốt. Nhưng k thể lồng giữa hàm vlookup ví dụ: XoaKT(Vlookup&vlookup). nếu có thể lồng hàm thì hay quá

 

[HieuCD]

Cảm ơn bạn rất nhiều. Code này dùng rất tốt. Nhưng k thể lồng giữa hàm vlookup ví dụ: XoaKT(Vlookup&vlookup). nếu có thể lồng hàm thì hay quá

Code chỉ viết theo bài #2, không viết cho các yêu cầu khác. Cần gì gởi file với dữ liệu, yêu cầu và kết quả minh họa khá đầy đủ