Xóa từ trong chuỗi theo điều kiện

Liên hệ QC
Để xem lại.

Đã thử:
1585623085428.png

Hay là code tôi đang chạy nó khác version? Dò không thấy, để post lại đúng code đang chạy:

Function XoaTu(ByVal chuoi As String, ByVal kytu As String)
' code xoa nhung tu trong chuoi co chua ky tu kytu
Static rx As Object
Dim i As Integer
If rx Is Nothing Then
Set rx = CreateObject("vbscript.regexp")
rx.ignorecase = True
rx.Global = True
End If
rx.Pattern = Replace(" [^p ]*[p].*? ", "p", kytu)
XoaTu = Application.Trim(rx.Replace(" " & Replace(chuoi, " ", " ") & " ", " "))
End Function
 
Lần chỉnh sửa cuối:
Để xem lại.

Đã thử:
View attachment 234383

Hay là code tôi đang chạy nó khác version? Dò không thấy, để post lại đúng code đang chạy:

Function XoaTu(ByVal chuoi As String, ByVal kytu As String)
' code xoa nhung tu trong chuoi co chua ky tu kytu
Static rx As Object
Dim i As Integer
If rx Is Nothing Then
Set rx = CreateObject("vbscript.regexp")
rx.ignorecase = True
rx.Global = True
End If
rx.Pattern = Replace(" [^p ]*[p].*? ", "p", kytu)
XoaTu = Application.Trim(rx.Replace(" " & Replace(chuoi, " ", " ") & " ", " "))
End Function
Có lẽ khác version , tôi vẫn chạy ra "u u" cả 2019 và 365
 
Có thể nó bị lỗi khác , bạn thử =XoaTu("u u u u","ôốồổỗộuúùủũụ") đúng ra nó phải trả về empty, nhưng kết quả là "u u"
bạn có thể dùng code này để cắt dấu tiềng việt. Sau đó dùng SUBSTITUTE để loại bỏ chữ U đi là xong
Mã:
Function TV(ByVal Text As String) As String
    On Error Resume Next
    Dim CharCode, ResText As String, i As Long, tmp As String
    tmp = Text
    CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
                     ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _
                     ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
                     ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _
                     ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _
                     ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _
                     ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _
                     ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _
                     ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
    ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
    For i = 0 To UBound(CharCode)
        tmp = Replace(tmp, CharCode(i), Mid(ResText, i + 1, 1))
        tmp = Replace(tmp, UCase(CharCode(i)), UCase(Mid(ResText, i + 1, 1)))
    Next
    TV = tmp
End Function
 
bạn có thể dùng code này để cắt dấu tiềng việt. Sau đó dùng SUBSTITUTE để loại bỏ chữ U đi là xong
Mã:
Function TV(ByVal Text As String) As String
    On Error Resume Next
    Dim CharCode, ResText As String, i As Long, tmp As String
    tmp = Text
    CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
                     ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _
                     ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
                     ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _
                     ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _
                     ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _
                     ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _
                     ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _
                     ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
    ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
    For i = 0 To UBound(CharCode)
        tmp = Replace(tmp, CharCode(i), Mid(ResText, i + 1, 1))
        tmp = Replace(tmp, UCase(CharCode(i)), UCase(Mid(ResText, i + 1, 1)))
    Next
    TV = tmp
End Function
Đâu cần xóa dấu làm gì bạn, nếu code dùng Regexp vẫn có thể nhận dạng được, mà cái trên chỉ là ví dụ thôi chứ mục đích của bài replace cả cụm từ chứa kí tự đó bạn ạ.
 
Có lẽ khác version , tôi vẫn chạy ra "u u" cả 2019 và 365
Chú ý cái phần ".*?", với dấu hỏi để buộc nó không tham lam (non greedy).
Có thể do cái cỗ máy VBScript.Regexp của bạn nó thuộc version khác, và code "không tham lam" khác.
Tôi không thử trên Mac được vì Mac không có VBScript. Mấy cái máy chạy Unix chắc cũng chịu thua thôi.
 
Chú ý cái phần ".*?", với dấu hỏi để buộc nó không tham lam (non greedy).
Có thể do cái cỗ máy VBScript.Regexp của bạn nó thuộc version khác, và code "không tham lam" khác.
Tôi không thử trên Mac được vì Mac không có VBScript. Mấy cái máy chạy Unix chắc cũng chịu thua thôi.
Có lẽ do khác version, chỗ greedy tôi bỏ "?" nó vẫn lấy dài nhất, tôi không hiểu chỗ "[^p ]*" nếu mặc định là lấy dài nhất tức là có khoảng trắng.
nếu tôi viết theo regexp thì :
rx.Pattern = Replace("\S*[p]\S*", "p", kytu)
XoaTu = Application.Trim(rx.Replace(chuoi, " "))

2020-03-31_11-45-14.png
 
"[^p ]*" phần này được dùng để buộc * không chứa luôn ký tự cần tìm
Nếu không có phần này, tôi bị nó xoá không hết. Nhưng chắc \S* cũng chả sao.
Tuy nhiên phần chống tham lam (?) thì không thể thiếu, vì nó dùng để chóng xoá nhiều hơn mong muốn. Muốn thử phần này, bạn phải thử câu có nhiều từ khác nhau.
 
"[^p ]*" phần này được dùng để buộc * không chứa luôn ký tự cần tìm
Nếu không có phần này, tôi bị nó xoá không hết. Nhưng chắc \S* cũng chả sao.
Tuy nhiên phần chống tham lam (?) thì không thể thiếu, vì nó dùng để chóng xoá nhiều hơn mong muốn. Muốn thử phần này, bạn phải thử câu có nhiều từ khác nhau.
Đây anh ơi. Khoẳng trắng lấy vào từ trước rồi.

1585634041396.png
 
Regexp của VBScript hơi khác với JavaScript một chút. Nhưng chắc trường hợp này không sao. Tôi nhớ hầu hết các chỗ khác nhau nằm ở chỗ "ngó trước dòm sau"

Thử với không có ? rồi. Và cũng đúng. Bây giờ thì quên mất tại sao tối qua mình phải có nó (lúc ấy thử, không có nó clear một hơi cả đống).
 
Lần chỉnh sửa cuối:
Dùng code củ chuối này thử.
Mã:
Public Function GPE_Filter(sValue As String) As String
    Dim Arr, i%, s$
    Arr = Split(sValue, " ")
    s = ""
    For i = 0 To UBound(Arr)
        If (Check_Value(CStr(Arr(i)))) Then
            If s = "" Then
                s = Arr(i)
            Else
                s = s & " " & Arr(i)
            End If
        End If
    Next i
    GPE_Filter = s
End Function

Public Function Check_Value(s As String) As Boolean
    Dim Arr, i%
    Arr = Array("ô", ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), "u", "ú", "ù", ChrW(7911), ChrW(361), ChrW(7909))
    For i = LBound(Arr) To UBound(Arr)
        If (InStr(1, s, Arr(i)) > 0) Or (InStr(1, s, UCase(Arr(i))) > 0) Then
            Check_Value = False
            Exit Function
        End If
    Next
    Check_Value = True
End Function
Hàm dùng như sau:
Mã:
=GPE_Filter(C6)
mục đích của cstr làm gì vậy, hỏi ngơ tí nhé
 

File đính kèm

  • screenshot_1585642172.png
    screenshot_1585642172.png
    18.5 KB · Đọc: 8
Có lẽ do khác version, chỗ greedy tôi bỏ "?" nó vẫn lấy dài nhất, tôi không hiểu chỗ "[^p ]*" nếu mặc định là lấy dài nhất tức là có khoảng trắng.
nếu tôi viết theo regexp thì :
rx.Pattern = Replace("\S*[p]\S*", "p", kytu)
XoaTu = Application.Trim(rx.Replace(chuoi, " "))
...
Tôi nhớ ra rồi. Lỗi do tôi có thành kiến với các ký hiệu "word boundary" khi áp dụng cho unicode tiếng Việt. Có một số regex engines hoạtn động chập choạng chỗ này.
mang thành kiến cho nên lúc đụng vào unicode là tôi dùng các kiểu hết sức cổ điển. Và bỏ qua \S, đó là điều mà tôi nhìn nhận thẳng là sai lầm nghiêm trọng. Nó gây sự rắc rối cho pattern tham lam và không tham lam.
 
Web KT
Back
Top Bottom