Tìm và thay thế (5 người xem)

[cuonghoa176]

Nhờ các thầy VBA xử lý giúp, e xin cảm ơn..!

 

[SA_DQ]

Đây là giai đoạn tìm, giai đoạn thay hay xóa còn phải bàn 1 tí

Sub TimVaThayThe()
 Dim Rng As Range, sRng As Range, Cls As Range
 Dim MyAdd As String
 Const MyColor As Integer = 38

 Set Rng = Range([A1], [A65500].End(xlUp))
 For Each Cls In Range([C2], [C2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart)
    If sRng Is Nothing Then
        Cls.Interior.ColorIndex = MyColor - 1
    Else
        MyAdd = sRng.Address
        Do
            If Cls.Offset(, 1).Value = "Xóa" Then
                sRng.Interior.ColorIndex = MyColor
            Else
                sRng.Interior.ColorIndex = MyColor + 1
            End If
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
 Next Cls
End Sub

Bạn kiểm tra thử giai đoạn I macro đã làm đúng hay chưa;
Giai đoạn sau đó ta bạn thêm chút: Đó lá xóa toàn ô tìm thấy hay chỉ xóa cụm từ tìm thấy mà thôi?

Chúc vui!

 

[cuonghoa176]

Chỉ xóa từ, cụm từ, kí tự tìm thấy trong chuỗi thôi bác ơi..!

 

[thnghiachau]

Chỉ xóa từ, cụm từ, kí tự tìm thấy trong chuỗi thôi bác ơi..!

Vậy bạn dựa trên code của Bác @SA_DQ mà làm tiếp:
thay: sRng.Interior.ColorIndex = MyColor thành sRng.value=Replace(sRng.Value, Cls.Value, "")
và thay sRng.Interior.ColorIndex = MyColor + 1 thành sRng.Value = Replace(sRng.Value, Cls.Value, Cls.Offset(, 1).Value)

 

[be_09]

Nhờ các thầy VBA xử lý giúp, e xin cảm ơn..!

Bạn thử sử dụng File:
1/ Copy dữ liệu rồi Paste vào cột A của sheet Cong trinh.
2/ Sang sheet Thay_The nhấn nút rồi xem kết quả.

Lưu ý:
- Trong cột C bạn thống kê chưa đầy đủ cụm từ cần xóa hoặc thay thế.
- Trong cột D cụm từ nào cần xóa thì để trống.

 

[cuonghoa176]

Kết quả mĩ mãn, e cảm ơn các bác..!

 

[cuonghoa176]

Kết quả mĩ mãn, e cảm ơn các bác..!
E có ý kiến, gọn hơn là bỏ qua sheet "Cong trinh", dữ liệu sẽ đặt luôn vào từ ô A2 Sheet "Thay thế"

 

[SA_DQ]

Vậy bạn dựa trên code của Bác @SA_DQ mà làm tiếp:
thay: sRng.Interior.ColorIndex = MyColor thành sRng.value=Replace(sRng.Value, Cls.Value, "")
và thay sRng.Interior.ColorIndex = MyColor + 1 thành sRng.Value = Replace(sRng.Value, Cls.Value, Cls.Offset(, 1).Value)

Cảnh báo coi chừng có trường hợp sẽ có kết quả không mong đợi đâu đó nha!

 

[be_09]

Kết quả mĩ mãn, e cảm ơn các bác..!
E có ý kiến, gọn hơn là bỏ qua sheet "Cong trinh", dữ liệu sẽ đặt luôn vào từ ô A2 Sheet "Thay thế"

Bạn check bỏ 2 dòng code (như hình) để sử dụng cho Sheet "Thay thế".

 

[Cu Tồ]

Các Bác cho em hỏi bài này có thể dùng VBScript RegExp để xử lý được không? Nếu có thể mong các bác làm file mẫu cho em tham khảo với ạ

 

[VetMini]

Các Bác cho em hỏi bài này có thể dùng VBScript RegExp để xử lý được không? Nếu có thể mong các bác làm file mẫu cho em tham khảo với ạ

Có thể dùng?
Cái từ "text" đó đã ngầm chứa trong "regular expression" rồi. Hầu như bất cứ việc gì xử lý chuỗi thì regexp đều làm được. Nhưng việc có hiệu quả hay không là vấn đề khác hoàn toàn.
Làm file mẫu:
Ở đây chỉ có một vài người chuyên viết những code "hoành tráng" kiểu đó thôi. Và họ có code mẫu rồi.
Bạn chịu khó tìm bài các người ấy thì sẽ ra.

Nếu không biết những người ấy là ai thì có lẽ từ lúc vào GPE đến giờ bạn chọn sai cách thức học rồi.
Muốn "tham khảo" code thì vệc đầu tiên là phải tập quan sát cách thức giải vấn đề, trường phái viết code cuỷa từng người trên diễn đàn.

 

[ptm0412]

Ở đây chỉ có một vài người chuyên viết những code "hoành tráng" kiểu đó thôi. Và họ có code mẫu rồi.
Bạn chịu khó tìm bài các người ấy thì sẽ ra.

Các bạn ấy cần biết thế nào là "hoành tráng" đúng nghĩa nữa anh. Cũng có người viết code hoành tráng theo kiểu hoa mỹ nhưng vô bổ

Nếu không biết những người ấy là ai thì có lẽ từ lúc vào GPE đến giờ bạn chọn sai cách thức học rồi.

Tương tự, người mới học hoặc mới tham gia dễ bị cái sự "hoành tráng" che mờ sự thật phía sau: viết code cho kêu, form cho lộng lẫy nhưng hiệu quả kém.

 

[VetMini]

Các bạn ấy cần biết thế nào là "hoành tráng" đúng nghĩa nữa anh. Cũng có người viết code hoành tráng theo kiểu hoa mỹ nhưng vô bổ

Tương tự, người mới học hoặc mới tham gia dễ bị cái sự "hoành tráng" che mờ sự thật phía sau: viết code cho kêu, form cho lộng lẫy nhưng hiệu quả kém.

Tôi cố tình dừng ở chỗ "hoành tráng", không diễn thêm nữa.
Bởi vì diễn thêm cái phần "hoa mỹ" lại bị chủ code tự ái, viết bài chửi bới, cạnh khoé...

 

[ptm0412]

Tôi cố tình dừng ở chỗ "hoành tráng", không diễn thêm nữa.
Bởi vì diễn thêm cái phần "hoa mỹ" lại bị chủ code tự ái, viết bài chửi bới, cạnh khoé...

Cũng chủ đề find, năm xưa có code viết phương thức find trong vòng lặp for ... next cho 65 ngàn dòng. Nếu người này được tìm thấy với danh "cao thủ" thì chết cho cả 1 thế hệ. Nên tôi chấp nhận bị "chửi"
-----------
Ghi chú: thế hệ dạy và học, sau đó dạy lại cho người sau, chứ không phải thế hệ tuổi tác

 

[Cu Tồ]

Có thể dùng?
Cái từ "text" đó đã ngầm chứa trong "regular expression" rồi. Hầu như bất cứ việc gì xử lý chuỗi thì regexp đều làm được. Nhưng việc có hiệu quả hay không là vấn đề khác hoàn toàn.
Làm file mẫu:
Ở đây chỉ có một vài người chuyên viết những code "hoành tráng" kiểu đó thôi. Và họ có code mẫu rồi.
Bạn chịu khó tìm bài các người ấy thì sẽ ra.

Nếu không biết những người ấy là ai thì có lẽ từ lúc vào GPE đến giờ bạn chọn sai cách thức học rồi.
Muốn "tham khảo" code thì vệc đầu tiên là phải tập quan sát cách thức giải vấn đề, trường phái viết code cuỷa từng người trên diễn đàn.

Vâng. Trong diễn đàn mình có Bác ChaoQuay từng viết code với RegExp rồi nhưng mà em muốn học hỏi thêm thôi,vì RegExp khá là rộng mà phần xử lý chuỗi mẫu thì hơi khoai với trình độ của em

Bài đã được tự động gộp: 13/9/20

Cũng chủ đề find, năm xưa có code viết phương thức find trong vòng lặp for ... next cho 65 ngàn dòng. Nếu người này được tìm thấy với danh "cao thủ" thì chết cho cả 1 thế hệ. Nên tôi chấp nhận bị "chửi"
-----------
Ghi chú: thế hệ dạy và học, sau đó dạy lại cho người sau, chứ không phải thế hệ tuổi tác

Em cũng mới vào diễn đàn học chưa lâu nên nhiều cái chưa rõ lắm Bác ,mong các Bác đi trước chỉ dạy để học hỏi thêm

 

[PacificPR]

Mơi vào... em không tin đâu

 

[Cu Tồ]

Mơi vào... em không tin đâu

Là sao Bác Em mới vào đây học thật mà

 

[CHAOQUAY]

@Cu Tồ
Bài viết này chỉ mang tính tham khảo.
Có lẽ việc thay đổi pattern nhiều lần sẽ làm thời gian chạy tăng lên đáng kể
Bạn có thể thử sửa dòng lệnh này để kiểm chứng: For i = 1 To 2 'UBound(bangtra) -> For i = 1 To UBound(bangtra)

Option Explicit

Sub Thaythe_Reg()
Dim nguon
Dim bangtra
Dim csD
Dim kq
Dim rws, i, j, k, x
With Sheet1
    nguon = .Range("A2", .Range("A2").End(xlDown))
    rws = UBound(nguon)
    bangtra = .Range("C2", .Range("D2").End(xlDown))
End With
ReDim kq(1 To rws, 1 To 1)
ReDim csD(1 To rws)
For i = 1 To rws
    csD(i) = i
Next i
With CreateObject("VbScript.RegExp")
    .Global = True
    For i = 1 To 2 'UBound(bangtra)
        .Pattern = Trim(bangtra(i, 1))
        
        x = UBound(csD)
        For j = 1 To UBound(csD)
            k = csD(j)
            If .test(nguon(k, 1)) Then
                kq(k, 1) = .Replace(nguon(k, 1), bangtra(i, 2))
                csD(j) = csD(x)
                x = x - 1
            End If
        Next j
        
        If x = 0 Then Exit For
        ReDim Preserve csD(1 To x)
    Next i
End With
With Sheet1
    .Range("F2").Resize(rws, 1).Clear
    .Range("F2").Resize(rws, 1) = kq
    .Range("F2").Resize(rws, 1).Borders.LineStyle = 1
    .Range("F2").Resize(rws, 1).Columns.AutoFit
End With
End Sub

---
Cao thủ dùng reg ở đây nhiều như mây ngày mưa, có lẽ là bạn tìm chưa đúng chỗ đấy thôi

 

[Cu Tồ]

@Cu Tồ
Bài viết này chỉ mang tính tham khảo.
Có lẽ việc thay đổi pattern nhiều lần sẽ làm thời gian chạy tăng lên đáng kể
Bạn có thể thử sửa dòng lệnh này để kiểm chứng: For i = 1 To 2 'UBound(bangtra) -> For i = 1 To UBound(bangtra)

Option Explicit

Sub Thaythe_Reg()
Dim nguon
Dim bangtra
Dim csD
Dim kq
Dim rws, i, j, k, x
With Sheet1
    nguon = .Range("A2", .Range("A2").End(xlDown))
    rws = UBound(nguon)
    bangtra = .Range("C2", .Range("D2").End(xlDown))
End With
ReDim kq(1 To rws, 1 To 1)
ReDim csD(1 To rws)
For i = 1 To rws
    csD(i) = i
Next i
With CreateObject("VbScript.RegExp")
    .Global = True
    For i = 1 To 2 'UBound(bangtra)
        .Pattern = Trim(bangtra(i, 1))
       
        x = UBound(csD)
        For j = 1 To UBound(csD)
            k = csD(j)
            If .test(nguon(k, 1)) Then
                kq(k, 1) = .Replace(nguon(k, 1), bangtra(i, 2))
                csD(j) = csD(x)
                x = x - 1
            End If
        Next j
       
        If x = 0 Then Exit For
        ReDim Preserve csD(1 To x)
    Next i
End With
With Sheet1
    .Range("F2").Resize(rws, 1).Clear
    .Range("F2").Resize(rws, 1) = kq
    .Range("F2").Resize(rws, 1).Borders.LineStyle = 1
    .Range("F2").Resize(rws, 1).Columns.AutoFit
End With
End Sub

---
Cao thủ dùng reg ở đây nhiều như mây ngày mưa, có lẽ là bạn tìm chưa đúng chỗ đấy thôi

Cảm ơn bác nhiều nha.Trên tinh thần học hỏi nên em hỏi xem có code của các bác thì em học hỏi thêm ạ

 

[Cu Tồ]

@Cu Tồ
Bài viết này chỉ mang tính tham khảo.
Có lẽ việc thay đổi pattern nhiều lần sẽ làm thời gian chạy tăng lên đáng kể
Bạn có thể thử sửa dòng lệnh này để kiểm chứng: For i = 1 To 2 'UBound(bangtra) -> For i = 1 To UBound(bangtra)

Option Explicit

Sub Thaythe_Reg()
Dim nguon
Dim bangtra
Dim csD
Dim kq
Dim rws, i, j, k, x
With Sheet1
    nguon = .Range("A2", .Range("A2").End(xlDown))
    rws = UBound(nguon)
    bangtra = .Range("C2", .Range("D2").End(xlDown))
End With
ReDim kq(1 To rws, 1 To 1)
ReDim csD(1 To rws)
For i = 1 To rws
    csD(i) = i
Next i
With CreateObject("VbScript.RegExp")
    .Global = True
    For i = 1 To 2 'UBound(bangtra)
        .Pattern = Trim(bangtra(i, 1))
       
        x = UBound(csD)
        For j = 1 To UBound(csD)
            k = csD(j)
            If .test(nguon(k, 1)) Then
                kq(k, 1) = .Replace(nguon(k, 1), bangtra(i, 2))
                csD(j) = csD(x)
                x = x - 1
            End If
        Next j
       
        If x = 0 Then Exit For
        ReDim Preserve csD(1 To x)
    Next i
End With
With Sheet1
    .Range("F2").Resize(rws, 1).Clear
    .Range("F2").Resize(rws, 1) = kq
    .Range("F2").Resize(rws, 1).Borders.LineStyle = 1
    .Range("F2").Resize(rws, 1).Columns.AutoFit
End With
End Sub

---
Cao thủ dùng reg ở đây nhiều như mây ngày mưa, có lẽ là bạn tìm chưa đúng chỗ đấy thôi

Hình như code này những chỗ cần xóa thì không xóa chuỗi mà xóa cả hàng đó luôn hay sao ấy bác ạ