Loại bỏ các ký trùng lặp được phân tách bằng dấu câu trong 01 ô tính

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài

vinhmq.ptc3

Thành viên mới
Tham gia
3/9/21
Bài viết
2
Được thích
0
Kính nhờ quý Anh chị giúp đỡ, em có đoạn code dùng để loại bỏ ký tự trùng trong 1 ô tính:
"Function RemoveDupes2(txt As String, Optional delim As String = " ") As String
Dim x
'Updateby Extendoffice
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For Each x In Split(txt, delim)
If Trim(x) <> "" And Not .exists(Trim(x)) Then .Add Trim(x), Nothing
Next
If .Count > 0 Then RemoveDupes2 = Join(.keys, delim)
End With
End Function"

1/ Bài toán VD: 01,03,07,03,09,10,09 --> Công thức = RemoveDupes2 (A2, ",") --> Kết quả: 01,03,07,09,10
2/ Mục tiêu em muốn loại bỏ luôn cả cặp ký tự trùng đó: VD như trên: 01,03,07,03,09,10,09 ---> Kết quả: 01,07,10
Kính nhờ Anh chị hổ trợ giúp ạ!
 
Kính nhờ quý Anh chị giúp đỡ, em có đoạn code dùng để loại bỏ ký tự trùng trong 1 ô tính:
.....
2/ Mục tiêu em muốn loại bỏ luôn cả cặp ký tự trùng đó: VD như trên: 01,03,07,03,09,10,09 ---> Kết quả: 01,07,10
Kính nhờ Anh chị hổ trợ giúp ạ!
Bạn thử thay dòng :
If Trim(x) <> "" And Not .exists(Trim(x)) Then .Add Trim(x), Nothing
Thành:
If Trim(x) <> "" And Not .exists(Trim(x)) Then
.Add Trim(x), Nothing
Else
Call .Remove(Trim(x))
End If

Và chạy thử.
 

Bạn đã thử chưa? Nếu phần từ lặp 2*n+1 lần thì đâu có loại được. Ví dụ 01,02,03,03,03

----
Bài này thông dụng là dùng 2 dic, hoặc dic + 1 nơi lưu trữ nào đó để kiểm soát phần tử xuất hiện 1 lần.
Nhưng có cách hay là dùng 1 object có tính năng kiểm tra sự tồn tại cả key và value. Nếu chịu khó thì cũng có thể tìm thấy nhiều bài áp dụng cái object đó rồi.
 
Kính nhờ quý Anh chị giúp đỡ, em có đoạn code dùng để loại bỏ ký tự trùng trong 1 ô tính:
"Function RemoveDupes2(txt As String, Optional delim As String = " ") As String
Dim x
'Updateby Extendoffice
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For Each x In Split(txt, delim)
If Trim(x) <> "" And Not .exists(Trim(x)) Then .Add Trim(x), Nothing
Next
If .Count > 0 Then RemoveDupes2 = Join(.keys, delim)
End With
End Function"

1/ Bài toán VD: 01,03,07,03,09,10,09 --> Công thức = RemoveDupes2 (A2, ",") --> Kết quả: 01,03,07,09,10
2/ Mục tiêu em muốn loại bỏ luôn cả cặp ký tự trùng đó: VD như trên: 01,03,07,03,09,10,09 ---> Kết quả: 01,07,10
Kính nhờ Anh chị hổ trợ giúp ạ!
Bạn thử code sau:
Mã:
Function RemoveDupes2(txt As String, Optional delim As String = " ") As String
    Dim i&, s$, tmp
    tmp = Split(txt, delim)
    txt = delim & txt & delim
    For i = 0 To UBound(tmp)
        If InStr(1, txt, tmp(i), 1) = InStrRev(txt, tmp(i), , 1) Then
            s = IIf(s = "", tmp(i), s & delim & tmp(i))
        End If
    Next
    RemoveDupes2 = s
End Function
 
Bạn đã thử chưa? Nếu phần từ lặp 2*n+1 lần thì đâu có loại được. Ví dụ 01,02,03,03,03

----
Bài này thông dụng là dùng 2 dic, hoặc dic + 1 nơi lưu trữ nào đó để kiểm soát phần tử xuất hiện 1 lần.
Nhưng có cách hay là dùng 1 object có tính năng kiểm tra sự tồn tại cả key và value. Nếu chịu khó thì cũng có thể tìm thấy nhiều bài áp dụng cái object đó rồi.
Cảm ơn anh đã xem bài và chỉ bảo.
Quả thật là tôi chỉ thử trên dữ liệu đã cho và cũng không nghĩ đến trường hợp phần tử có lặp 2*n+1 lần.
 
Bạn thử thay dòng :
If Trim(x) <> "" And Not .exists(Trim(x)) Then .Add Trim(x), Nothing
Thành:
If Trim(x) <> "" And Not .exists(Trim(x)) Then
.Add Trim(x), Nothing
Else
Call .Remove(Trim(x))
End If

Và chạy thử.
Cảm ơn Chị nhé. Em đã chạy thử, dự liêu báo lỗi ạ. E đã thử chạy đoạn mã bên dưới của anh Nhattan --> Kết quả: OK ạ
Bài đã được tự động gộp:

Bạn thử code sau:
Mã:
Function RemoveDupes2(txt As String, Optional delim As String = " ") As String
    Dim i&, s$, tmp
    tmp = Split(txt, delim)
    txt = delim & txt & delim
    For i = 0 To UBound(tmp)
        If InStr(1, txt, tmp(i), 1) = InStrRev(txt, tmp(i), , 1) Then
            s = IIf(s = "", tmp(i), s & delim & tmp(i))
        End If
    Next
    RemoveDupes2 = s
End Function
Cảm ơn anh nhé. Em đã chạy thử, dữ liệu hoạt động tốt ạ
 
Web KT

Bài viết mới nhất

Back
Top Bottom