Tìm và thay thế chuỗi ở tất cả các Sheets, đếm số lần thực hiện.

[cantl]

Chào các bác,
Em tìm và thay thế chuỗi "*b" & ChrW(7857) & "ng ch" & ChrW(7919) & "*" trong tất cả các Sheets của Workbook.
Em muốn đếm số lần chuỗi được thay thế. (Nếu dùng CTRL+H như ảnh thì Excel đếm được).
Hiện code dưới thì duyệt qua các Sheets nên chỉ có thể đếm được số Sheets.
Có cách nào đếm sự thay đổi Replace ngay trong vòng lặp For Each không ạ? (em muốn cái này hơn)
Nếu không thì nhờ các bác cho em phương án khác nhé.

Sub XoaBgChu()
    Dim ws As Worksheet
    Dim bchu As String
    Dim trong  As String
    Application.ScreenUpdating = False
    bchu = "*b" & ChrW(7857) & "ng ch" & ChrW(7919) & "*"
    trong = ""
    For Each ws In Worksheets
        ws.Cells.Replace What:=bchu, Replacement:=trong, _
        LookAt:=xlPart, MatchCase:=False
    i = i + 1
    Next
    Application.ScreenUpdating = True
    MsgBox "Thay " & i & " lan!!!"             'bi saiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii roi
End Sub

 

[hvnhpro]

i là trong vòng lặp sheets mà bạn. đếm số lần replace phải tìm biến khác.
hóng xem cách đếm như thế nào

 

[cantl]

i là trong vòng lặp sheets mà bạn. đếm số lần replace phải tìm biến khác.

Tớ hiểu, tớ đang không biết đếm số lần Replace thực hiện thực sự ấy. Vậy Ctrl+H, họ đã làm điều đó như thế nào?

 

[curet]

Bạn thêm điều kiện này sau vòng lặp for each xem

If Application.CountIf(ws.UsedRange, bchu) > 0 Then

 

[heyhey1994]

Sub ReplaceTextInAllSheets()
    Dim ws As Worksheet
    Dim cell As Range
    Dim replaceCount As Integer
    Dim bchu As String
    Dim trong  As String
    
    replaceCount = 0
    bchu = "A"
    trong = "B"
    For Each ws In ThisWorkbook.Sheets
        For Each cell In ws.UsedRange.Cells 
            If cell.HasFormula = False Then 
                If InStr(1, cell.Value, bchu, vbTextCompare) > 0 Then 
                    cell.Value = Replace(cell.Value, bchu, trong, , , vbTextCompare) 
                    replaceCount = replaceCount + 1
                End If
            End If
        Next cell
    Next ws
    
    MsgBox "Thay " & replaceCount & " lan!!!"
End Sub

Thử code này nhé bạn, hi vọng đúng ý.

 

[cantl]

Bạn thêm điều kiện này sau vòng lặp for each xem

If Application.CountIf(ws.UsedRange, bchu) > 0 Then

Tớ chạy rồi, nó đếm số Sheets thực hiện, nhưng nếu trong Sheet có 2 ô thay thế thì đếm bị thiếu.

Bài đã được tự động gộp: 25/5/23

Thử code này nhé bạn, hi vọng đúng ý.

Tớ thay bằng:
bchu = "*b" & ChrW(7857) & "ng ch" & ChrW(7919) & "*"
trong = ""
Mà kết quả không thay thế và Thông báo là 0 lần bạn ơi.

 

[hvnhpro]

Sub ReplaceTextInAllSheets()
    Dim ws As Worksheet
    Dim cell As Range
    Dim replaceCount As Integer
    Dim bchu As String
    Dim trong  As String
   
    replaceCount = 0
    bchu = "A"
    trong = "B"
    For Each ws In ThisWorkbook.Sheets
        For Each cell In ws.UsedRange.Cells
            If cell.HasFormula = False Then
                If InStr(1, cell.Value, bchu, vbTextCompare) > 0 Then
                    cell.Value = Replace(cell.Value, bchu, trong, , , vbTextCompare)
                    replaceCount = replaceCount + 1
                End If
            End If
        Next cell
    Next ws
   
    MsgBox "Thay " & replaceCount & " lan!!!"
End Sub

Thử code này nhé bạn, hi vọng đúng ý.

code này là đếm cell, nếu chữ cần thay thế trong cell xuất hiện >1 lần thì không đúng nữa

 

[curet]

Nếu thế thì cộng thẳng nó nào biến i luôn

i = i + Application.CountIf(ws.UsedRange, bchu)

Do bchu có ký tự *&...&* nên đếm được chứ thay chính xác text như Ctrl-H thì báo lỗi

 

[bebo021999]

Trước khi Replace thì mình đếm trước đi, sau đó mới xóa.
count1: Đếm chuỗi trong từng sheet
count2: Cộng dồn tất cả

Sub XoaBgChu()
    Dim ws As Worksheet
    Dim bchu As String, count1&, count2&
    Dim trong  As String
    Application.ScreenUpdating = False
    bchu = "*b" & ChrW(7857) & "ng ch" & ChrW(7919) & "*"
    trong = ""
    For Each ws In Worksheets
        count1 = WorksheetFunction.countIf(ws.Range("A1:ZZ10000"), bchu)
        ws.Cells.Replace What:=bchu, Replacement:=trong, _
        LookAt:=xlPart, MatchCase:=False
        count2 = count2 + count1
    Next
    Application.ScreenUpdating = True
    MsgBox "Thay " & count2 & " lan!!!"
End Sub

 

[cantl]

A1:ZZ10000

Em thử full option (với 1 Sheet) thì VBA của bác chạy được. CTRL+H thì bị văng excel.

 

[VetMini]

Bạn đếm trước rồi mới thực hiện thay thế thì theo lô gic toán là đúng và hiệu quả.
Nhưng theo luật lập trình thì đó llaf phương pháp không bảo đảm.

Bài này nếu muốn làm đúng thì phải dùng Find, và replace từng lần một. Đã làm công việc "đếm" tức là kiểm soát. Mà đã kiểm soat thì tốc độ là thứ yếu.

 

[cantl]

Bạn đếm trước rồi mới thực hiện thay thế thì theo lô gic toán là đúng và hiệu quả.
Nhưng theo luật lập trình thì đó llaf phương pháp không bảo đảm.

Bài này nếu muốn làm đúng thì phải dùng Find, và replace từng lần một. Đã làm công việc "đếm" tức là kiểm soát. Mà đã kiểm soat thì tốc độ là thứ yếu.

Thực ra thao tác xóa dòng này thường xuyên lặp lại nên em làm code cho nhanh, đỡ phải CTRL+H thôi bác.
Đồng thời muốn chắc cú là thay bao nhiêu lần để có cái Msgbox cho nó rõ ràng tí.
Còn tạo đầy dữ liệu là em thử xem VBA và CTRL+H tốc độ thế nào thôi, và CTRL+H thì bị bay excel, chắc do Office Pro Ultimate rắc.