Tìm và thay thế

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia ngày
8 Tháng sáu 2006
Bài viết
11,728
Được thích
17,562
Điểm
1,860
Đây là giai đoạn tìm, giai đoạn thay hay xóa còn phải bàn 1 tí
PHP:
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!
 

thnghiachau

Thành viên bị đình chỉ hoạt động
Thành viên bị đình chỉ hoạt động
Tham gia ngày
14 Tháng chín 2009
Bài viết
604
Được thích
478
Điểm
735
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)
 
Lần chỉnh sửa cuối:

be09

TNMT_Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
9,438
Được thích
9,197
Điểm
560
Tuổi
63
Nơi ở
Biên Hòa, Đồng Nai
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.
 

File đính kèm

cuonghoa176

Hỏi nhiều
Tham gia ngày
31 Tháng một 2011
Bài viết
165
Được thích
23
Điểm
370
Nơi ở
T9-Quyết Thắng-TP Sơn La
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

/(hông là gì!
Thành viên danh dự
Tham gia ngày
8 Tháng sáu 2006
Bài viết
11,728
Được thích
17,562
Điểm
1,860
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!
 

be09

TNMT_Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
9,438
Được thích
9,197
Điểm
560
Tuổi
63
Nơi ở
Biên Hòa, Đồng Nai

Cu Tồ

Tìm đến kiến thức!
Tham gia ngày
6 Tháng năm 2020
Bài viết
191
Được thích
43
Điểm
20
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

Chuyên gia GPE
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
9,881
Được thích
11,893
Điểm
1,560
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

Excel Ordinary Member
Thành viên BQT
Super Moderator
Tham gia ngày
4 Tháng mười một 2007
Bài viết
9,784
Được thích
29,424
Điểm
1,910
Tuổi
58
Nơi ở
Gò Vấp
Ở đâ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

Chuyên gia GPE
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
9,881
Được thích
11,893
Điểm
1,560
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

Excel Ordinary Member
Thành viên BQT
Super Moderator
Tham gia ngày
4 Tháng mười một 2007
Bài viết
9,784
Được thích
29,424
Điểm
1,910
Tuổi
58
Nơi ở
Gò Vấp
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ồ

Tìm đến kiến thức!
Tham gia ngày
6 Tháng năm 2020
Bài viết
191
Được thích
43
Điểm
20
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:

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
 

CHAOQUAY

Thành viên tích cực
Tham gia ngày
24 Tháng tám 2018
Bài viết
1,293
Được thích
1,395
Điểm
360
@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)

Mã:
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
 
Lần chỉnh sửa cuối:

Cu Tồ

Tìm đến kiến thức!
Tham gia ngày
6 Tháng năm 2020
Bài viết
191
Được thích
43
Điểm
20
@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)

Mã:
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ồ

Tìm đến kiến thức!
Tham gia ngày
6 Tháng năm 2020
Bài viết
191
Được thích
43
Điểm
20
@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)

Mã:
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 ạ
 
Top Bottom