Sub
Macro1()
Dim i As Integer
Dim FindStr As String
Dim RepStr As String
For i = 2 To 7
FindStr = Sheet1.Range("A" & i).Value
RepStr = Sheet1.Range("B" & i).Value
ActiveWorkbook.Sheets(2).Cells.Replace What:=FindStr, Replacement:=RepStr
Next i
End SubSub Macro1()
Dim i As Integer
Dim FindStr As String
Dim RepStr As String
Dim followingChar As String
Dim pos As Integer
' Lặp từ dòng 2 đến 7 của Sheet 1 để lấy dữ liệu cần tìm kiếm và thay thế
For i = 2 To 7
FindStr = Sheet1.Range("A" & i).Value
RepStr = Sheet1.Range("B" & i).Value
' Check mỗi cell trong khoảng đã dùng ( chạy nhanh hơn so với ActiveWorkbook.Sheets(2).Cells )
For Each cell In ActiveWorkbook.Sheets(2).UsedRange.Cells
' Bỏ qua cell rỗng, chỉ cell nào chứa dữ liệu mới check
If Not IsEmpty(cell) Then
' tìm vị trí của từ cần thay thế trong nội dung của cell
pos = InStr(1, cell.Value, FindStr)
Select Case pos
' không tìm thấy - > không làm gì cả
Case 0
' nếu vị trí = 1 - > từ cần tìm để thay ở ngay đầu tiên
Case 1
' xem sau từ đó là kí tự gì
followingChar = Mid(cell.Value, Len(cell.Value) + 1, 1)
' nếu kí tự đó là dấu cách " ", dấu phẩy " " hoặc kí tự rỗng "", ... cái này bạn tự check thêm nha
If followingChar = " " Or followingChar = "," Or followingChar = "" Then
' thì thay thế
cell.Replace What:=FindStr, Replacement:=RepStr
End If
' nếu vị trí tìm thấy lớn hơn 1, thi ta phải check kí tự liền trước và kí tự liền sau của từ cần tìm ... tương tự như trên.
Case Else
followingChar = Mid(cell.Value, pos - 1, 1)
If followingChar = " " Then
followingChar = Mid(cell.Value, pos + Len(cell.Value), 1)
If followingChar = " " Or followingChar = "," Or followingChar = "" Then
cell.Replace What:=FindStr, Replacement:=RepStr
End If
End If
End Select
End If
Next cell
Next i
End SubSub macro3()
Dim i As Integer
Dim FindStr As String
Dim RepStr As String
Dim pos As IntegerFor i = 2 To 7
FindStr = Sheet1.Range("A" & i).Value
RepStr = Sheet1.Range("B" & i).Value
For Each cell In ActiveWorkbook.Sheets(2).UsedRange.Cells
If Not IsEmpty(cell) Then
If ExactWordInString(cell.Value, FindStr) Then
cell.Replace What:=FindStr, Replacement:=RepStr
End If
End If
Next cell
Next i
End Sub
Function ExactWordInString(Text As String, Word As String) As Boolean
ExactWordInString = " " & UCase(Text) & " " Like "*[!A-Z]" & UCase(Word) & "[!A-Z]*"
End Function
Mình có thử với code này thấy cũng được đó nhưng chưa biết chủ topic có xài được không
Sub Tim_ThayThe()
Dim nguon(), i&
With Sheet1
nguon = .Range("A2", .[B65536].End(3)).Value
End With
With Sheet2.UsedRange
For i = 1 To UBound(nguon)
.Replace nguon(i, 1), nguon(i, 2), 1
.Replace " " & nguon(i, 1), " " & nguon(i, 2), 2
Next
End With
End Sub
