Làm thế nào để sửa những từ trùng lặp trong 1 ô cell. Ví dụ như là: được được => được, bị bị => bị,…

[hung2412]

Xin chào các bạn GPE!
Tôi có 1 vấn đề cần được các bạn giúp cho.
Làm thế nào để sửa những từ trùng lặp trong 1 ô cell. Ví dụ như là: được được => được, bị bị => bị,…

Mong các bạn giúp cho.

 

[befaint]

Gặp từ láy lặp lại thì tắt điện đi ngủ.

Ví dụ:
Hai đường thẳng song song.
Bông hoa xinh xinh.
Cành cây cong cong.

 

[CHAOQUAY]

Xin chào các bạn GPE!
Tôi có 1 vấn đề cần được các bạn giúp cho.
Làm thế nào để sửa những từ trùng lặp trong 1 ô cell. Ví dụ như là: được được => được, bị bị => bị,…
View attachment 254152
Mong các bạn giúp cho.

Bài này có lẽ bạn lập bảng tra các từ lặp rồi dùng công thức thay thế cho tiện

 

[VetMini]

Bài này có lẽ bạn lập bảng tra các từ lặp rồi dùng công thức thay thế cho tiện

Gặp tiếng Phạn lấy gì lập bảng tra?

Bài này chỉ giản dị một hàm VBA split từ ra, so sánh, xoá, rồi join lại thôi. Rườm rà chi cho mệt.
Réc-ét cũng được nhung có lẽ rắc rối không cần thiết.

 

[VetMini]

Đầu năm khai cốt:

"Te te", "Te te te" thành "Te":
Option Compare Text
Function LoaiTuDoi(chuoi As String) As String
Dim a, i
a = Split(chuoi, " ")
For i = LBound(a) To UBound(a) -1
If a(i) = a(i+1) Then
a(i+1) = a(i)
a(i) = ""
End If
Next i
LoaiTuDoi = Application.Trim(Join(a, " "))
End Function

"Te te", "Te te te" thành "te":
Option Compare Text
Function LoaiTuDoi(chuoi As String) As String
Dim a, i
a = Split(chuoi, " ")
For i = LBound(a) To UBound(a) -1
If a(i) = a(i+1) Then a(i) = ""
Next i
LoaiTuDoi = Application.Trim(Join(a, " "))
End Function

"Te te" không đổi. Chỉ "te te", "te te te" thành "te":
Function LoaiTuDoi(chuoi As String) As String
Dim a, i
a = Split(chuoi, " ")
For i = LBound(a) To UBound(a) -1
If a(i) = a(i+1) Then a(i) = ""
Next i
LoaiTuDoi = Application.Trim(Join(a, " "))
End Function

 

[dazkangel]

Làm đại công thức, lặp lại hơi nhiều @@

=SUBSTITUTE(B3,IFERROR(LOOKUP(2,1/SEARCH(TEXT(FILTERXML("<a><b>"&SUBSTITUTE(B3," ","</b><b>")&"</b></a>","//b"),"@ @"),B3),TEXT(FILTERXML("<a><b>"&SUBSTITUTE(B3," ","</b><b>")&"</b></a>","//b"),"@ @")),""),IFERROR(LOOKUP(2,1/SEARCH(TEXT(FILTERXML("<a><b>"&SUBSTITUTE(B3," ","</b><b>")&"</b></a>","//b"),"@ @"),B3),FILTERXML("<a><b>"&SUBSTITUTE(B3," ","</b><b>")&"</b></a>","//b")),""))

 

[batman1]

Công thức bài #7 hiện bó tay với "có thể khống chế được được rất rất nhiều nhiều lỗi lỗi".

Có thể chủ thớt chỉ có 1 từ lặp lại. Nhưng với ô có Vâng vâng ạ! thì vẫn bó tay.

Tôi chưa nghĩ kỹ các trường hợp nên không đem đầu ra đảm bảo.

Đã phát hiện ra 1 trường hợp. Code sai với các kiểu dữ liệu Cha chan cơm (kết quả là Chan cơm) ***

Option Explicit

'    Sub tổng quát
Sub LoaiTuTrung(ByVal source As Range, ByVal dest As Range)
'    source: vùng dữ liệu nằm trong 1 cột chứa dữ liệu cần rút gọn.
'    dest: vị trí cần nhập kết quả rút gọn. Nếu là vùng nhiều ô thì chỉ lấy ô đầu tiên.
Dim r As Long, re As Object, dulieu()
    dulieu = source.Value

    Set re = CreateObject("VBScript.RegExp")
    re.Global = True
    re.IgnoreCase = True
    re.Pattern = "(\s\S+)\1+"
    For r = 1 To UBound(dulieu, 1)
        If re.test(" " & dulieu(r, 1)) Then dulieu(r, 1) = Trim(re.Replace(" " & dulieu(r, 1), "$1"))
    Next
    dest(1).Resize(UBound(dulieu, 1)).Value = dulieu
    Set re = Nothing
End Sub

'    ví dụ về sử dụng sub LoaiTuTrung
Sub test()
Dim lastRow As Long
    ThisWorkbook.Worksheets("Sheet1").Range("F3:F10000").ClearContents
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
        If lastRow < 3 Then Exit Sub
    End With
    With ThisWorkbook.Worksheets("Sheet1")
        LoaiTuTrung .Range("B3:B" & lastRow + 1), .Range("F3:F100")
    End With
End Sub

***

Thử sửa thành (chỉ sửa re.Pattern = "(\s\S+)\1+(?=$|\s|,|\.|!)")

Sub LoaiTuTrung(ByVal source As Range, ByVal dest As Range)
'    source: vùng dữ liệu nằm trong 1 cột chứa dữ liệu cần rút gọn.
'    dest: vị trí cần nhập kết quả rút gọn. Nếu là vùng nhiều ô thì chỉ lấy ô đầu tiên.
Dim r As Long, re As Object, dulieu()
    dulieu = source.Value

    Set re = CreateObject("VBScript.RegExp")
    re.Global = True
    re.IgnoreCase = True
    re.Pattern = "(\s\S+)\1+(?=$|\s|,|\.|!)"
    For r = 1 To UBound(dulieu, 1)
        If re.test(" " & dulieu(r, 1)) Then dulieu(r, 1) = Trim(re.Replace(" " & dulieu(r, 1), "$1"))
    Next
    dest(1).Resize(UBound(dulieu, 1)).Value = dulieu
    Set re = Nothing
End Sub

If re.test(" " & dulieu(r, 1)) Then là không bắt buộc. Có thể rút gọn thành

dulieu(r, 1) = Trim(re.Replace(" " & dulieu(r, 1), "$1"))

 

[HieuCD]

Xét các ký tự kết thúc câu thông thường

Option Compare Text

Function LoaiTuTrung(iStr As String)
  Dim Arr, i&, tmp$
  Arr = Split(iStr, " ")
  For i = 0 To UBound(Arr) - 1
    tmp = Arr(i + 1)
    If InStr(1, ",.;:?!", Right(tmp, 1)) Then tmp = Mid(tmp, 1, Len(tmp) - 1)
    If Arr(i) = tmp Then Arr(i) = ""
  Next i
  LoaiTuTrung = Application.Trim(Join(Arr, " "))
End Function

Chạy Sub lấy kết quả

Sub Main()
  Dim sArr(), Res(), sR&, i&
  sArr = Range("B3", Range("B65000").End(xlUp)).Value
  sR = UBound(sArr)
  ReDim Res(1 To sR, 1 To 1)
  For i = 1 To sR
    Res(i, 1) = LoaiTuTrung(CStr(sArr(i, 1)))
  Next i
  Range("C3").Resize(sR) = Res
End Sub

 

[VetMini]

Chỉnh code bài #5

"Te te", "Te te te" thành "Te", và "Te te," thành "Te,":
Option Compare Text
Function LoaiTuDoi(chuoi As String) As String
Dim a, i
a = Split(chuoi, " ")
For i = LBound(a) To UBound(a) -1
If a(i) = a(i+1) Then
a(i+1) = a(i)
a(i) = ""
ElseIf a(i+1) Like a(i) & "[,.;:?!]" Then
a(i+1) = Replace(a(i+1), a(i), a(i))
a(i) = ""
End If
Next i
LoaiTuDoi = Application.Trim(Join(a, " "))
End Function

Không hảo với file xls, lười thử quá.

 

[ptm0412]

Nó rông từ lúc nhìn hình bài #1 để đoán dữ liệu. Đâu chờ đến cốt. Đã nói tôi ngại mở file xls mờ.

Cứ quay về Find and replace cho chắc cú. Láy hay không láy, đầu đuôi hay giữa thì người biết chứ cốt xương nào biết được.

 

[HeSanbi]

hung2412​

Bạn có thể sử dụng Biểu thức chính quy trong trường hợp này, ví dụ như biểu thức ở hàm bên dưới:
=RemoveContinuity("chuỗi chuỗi và chuỗi")
Hàm này sẽ xóa đi những từ liền sau khớp nhưng không phân biệt hoa thường.

CODE #36

 

[batman1]

hung2412​

Bạn có thể sử dụng Biểu thức chính quy trong trường hợp này, ví dụ như biểu thức ở hàm bên dưới:
=RemoveContinuity("chuỗi chuỗi và chuỗi")
Hàm này sẽ xóa đi những từ liền sau khớp nhưng không phân biệt hoa thường.

Function RemoveContinuity(ByVal Text As String)
  Static R As Object
  If R Is Nothing Then
    Set R = VBA.CreateObject("VBScript.RegExp")
    With R
      .Global = 1: .IgnoreCase = 1
      .Pattern = "([^\n\r\t\s .,\(\)!""';?]+) (?=\1\b)"
    End With
  End If
  RemoveContinuity = R.Replace(Text, vbNullString)
End Function

Đồng ý là không phân biệt hoa thường nhưng vd. với "Te te." thì kết quả phải là "Te." (viết hoa đầu câu) chứ không thể là "te." được.

Ngoài ra code chưa chính xác.

Vài ví dụ:

Có thể nói là là
không có điều gì là chân thật cả cả
hạ hạ căn
đê đê mê mê chứ chứ bộ bộ
bé xinh xinh nho nhỏ
Ý muốn nói là là

Kết quả trả về bởi công thức:

Có thể nói là là - không đổi
không có điều gì là chân thật cả cả - không đổi.
hạ hạ căn - không đổi.
đê đê mê mê chứ chứ bộ bộ - không đổi.
bé xinh nhỏ - mất nho
Ý muốnói là là - "muốn nói" dính với nhau và mất 1 chữ n, "là là" không đổi.

--------------
Thường thì ai cũng khó nhìn thấy lỗi của mình, nhưng nhìn rõ lỗi của người khác. Lý do theo tôi là khi viết và khi kiểm ttra thì ta luôn có tư duy giống nhau, vì thế rất dễ phạm lỗi khi đánh giá ở cùng chỗ có lỗi khi viết. Tôi chưa nhìn ra lỗi trong code của mình. Nếu ai nhìn thấy lỗi thì cho biết nhé.

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

Chắc có lẽ bói nhầm phải bói bù mất rồi

Nhầm chỗ nào hả bạn? Sao tôi không nhìn thấy nhỉ. Bạn có thể chỉ ra 1 ví dụ không?

 

[HeSanbi]

Đồng ý là không phân biệt hoa thường nhưng vd. với "Te te." thì kết quả phải là "Te." (viết hoa đầu câu) chứ không thể là "te." được.

Ngoài ra code chưa chính xác.

Vài ví dụ:

Có thể nói là là
không có điều gì là chân thật cả cả
hạ hạ căn
đê đê mê mê chứ chứ bộ bộ
bé xinh xinh nho nhỏ
Ý muốn nói là là

Kết quả trả về bởi công thức:

Có thể nói là là - không đổi
không có điều gì là chân thật cả cả - không đổi.
hạ hạ căn - không đổi.
đê đê mê mê chứ chứ bộ bộ - không đổi.
bé xinh nhỏ - mất nho
Ý muốnói là là - "muốn nói" dính với nhau và mất 1 chữ n, "là là" không đổi.

--------------

Vấn đề nằm ở xử lý Unicode trong Regex, và cách bên dưới sẽ giúp quét dọn sạch sẻ Unicode tổ hợp, "Te te." cũng sẽ đẹp với kết quả "Te."

Function RemoveContinuity(ByVal Text As String)
  Static R As Object
  If R Is Nothing Then
    Const s = "\n\r\t\s .,\(\)!""':;_-"
    Set R = VBA.CreateObject("VBScript.RegExp")
    With R
      .Global = 1: .IgnoreCase = 1: .MultiLine = 1
      .Pattern = "(?:^|[" & s & "])([^" & s & "]+)(?= \1(?:$|[" & s & "]))"
    End With
  End If
  RemoveContinuity = Application.Trim(VBA.StrReverse(R.Replace(VBA.StrReverse(Text), " ")))
End Function

 

[batman1]

Vấn đề nằm ở xử lý Unicode trong Regex, và cách bên dưới sẽ giúp quét dọn sạch sẻ Unicode tổ hợp, "Te te." cũng sẽ đẹp với kết quả "Te."

Function RemoveContinuity(ByVal Text As String)
  Static R As Object
  If R Is Nothing Then
    Const s = "\n\r\t\s .,\(\)!""':;_-"
    Set R = VBA.CreateObject("VBScript.RegExp")
    With R
      .Global = 1: .IgnoreCase = 1: .MultiLine = 1
      .Pattern = "(?:^|[" & s & "])([^" & s & "]+)(?= \1(?:$|[" & s & "]))"
    End With
  End If
  RemoveContinuity = Application.Trim(VBA.StrReverse(R.Replace(VBA.StrReverse(Text), " ")))
End Function

Code chưa chuẩn nên tôi góp ý thôi. Bạn không cần phải giải thích cho tôi vì tôi biết. Người ta đính kèm tập tin rõ ràng có unicode trong từng cell mà bạn không để ý thấy?