.Replace What:=oldText, Replacement:=newText, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=FalseOption Explicit
Sub TimVaThayThe()
Dim DiaChi As String 'Sa
Dim MyRng As Range, Rng As Range
Set MyRng = Range(Cells(1, 1), Cells(18, 4))
Dim oldText As String, newText As String
oldText = "3"
newText = "test"
With MyRng
Set Rng = .Find(What:=oldText, LookIn:=xlValues, LookAt:=xlWhole)
Set Rng = .Find(What:=oldText, After:=ActiveCell,LookIn:=xlValues, LookAt:=xlxlPart)
If Not Rng Is Nothing Then
DiaChi = Rng.Address
Do
With Rng.Offset(, 5)
With Rng
.Value = newText
.Interior.ColorIndex = 36
.Font.Bold = True
End With
Set Rng = .FindNext(Rng)
If Rng Is Nothing Then Exit Sub
Loop While Not Rng Is Nothing And Rng.Address <> DiaChi
End If
End With
End Sub
Sub TimVaGan()
Dim DiaChi As String, i As Long
Dim MyRng As Range, Rng As Range
Set MyRng = Range(Cells(1, 1), Cells(18, 4))
Dim oldText As String
Dim MyArr()
i = 1
ReDim MyArr(1 To MyRng.Count)
oldText = "3"
With MyRng
Set Rng = .Find(What:=oldText, LookIn:=xlValues, LookAt:=xlPart)
If Not Rng Is Nothing Then
DiaChi = Rng.Address
Do
MyArr(i) = Rng.Value
i = i + 1
Set Rng = .FindNext(Rng)
If Rng Is Nothing Then GoTo bien
Loop While Not Rng Is Nothing And Rng.Address <> DiaChi
End If
End With
bien:
With Sheets("sheet2")
.Cells.ClearContents
For i = LBound(MyArr) To UBound(MyArr)
.Cells(i, 1) = MyArr(i)
Next
End With
End Sub
ThuNghi nhờ thì hiệu đính thôi, chứ tuyệt nhiên không có ý định gây áp lực đâu HoangDanh nha
Option Explicit
Sub TimVaThayThe()
Dim DiaChi As String
Dim MyRng As Range, Rng As Range
Set MyRng = Range(Cells(1, 1), Cells(18, "D"))
' Dim newText As String'
Const oldText As Long = 3
With MyRng
Set Rng = .Find(What:=oldText, LookIn:=xlValues, LookAt:=xlWhole)
If Not Rng Is Nothing Then
DiaChi = Rng.Address
Do
With Rng
.Value = "test": .Font.Bold = True
.Interior.ColorIndex = 36
End With
Set Rng = .FindNext(Rng)
If Rng Is Nothing Then Exit Sub
Loop While Not Rng Is Nothing And Rng.Address <> DiaChi
End If
End With
End SubOption Explicit
Sub xIndex()
With Application
.ScreenUpdating = False
End With
Dim DiaChi As String, eRow As Long, iR As Long
Dim MyRng As Range, Rng As Range, RngDM As Range
Dim oldText As String
Sheets("Data").Select
With Sheets("Index")
eRow = .[a1000].End(xlUp).Row - 1
Set RngDM = .Range(.Cells(2, 1), .Cells(eRow, 3))
End With
Columns("B:B").ClearComments
Columns("A:D").ClearFormats
eRow = [a1000].End(xlUp).Row
Range(Cells(2, 3), Cells(eRow, 4)).ClearContents
Set MyRng = Range(Cells(2, 2), Cells(eRow, 2))
For iR = 1 To eRow
oldText = RngDM.Cells(iR)
With MyRng
Set Rng = .Find(What:=oldText, LookIn:=xlValues, LookAt:=xlWhole)
If Not Rng Is Nothing Then
DiaChi = Rng.Address
Do
With Rng
If .Value = "A1" Then
With .Offset(0, -1).Resize(, 4).Font
.ColorIndex = 5
.Bold = True
End With
.AddComment
.Comment.Visible = False
.Comment.Text Text:="GPE:" & Chr(10) & "OK"
End If
.Offset(, 1).Value = RngDM.Cells(iR).Offset(, 1)
With .Offset(, 2)
.Value = RngDM.Cells(iR).Offset(, 2)
.NumberFormat = "#,##0"
End With
End With
Set Rng = .FindNext(Rng)
If Rng Is Nothing Then Exit Sub
Loop While Not Rng Is Nothing And Rng.Address <> DiaChi
End If
End With
Next
Set RngDM = Nothing
Set MyRng = Nothing
With Application
.ScreenUpdating = True
End With
End SubTheo ý mình nó như vầy; Nói nhỏ:"Ngoài cách giới thiệu phương thức FIND(), macro này là một điển hình về cách dùng
Option Explicit
Sub xIndex()
Dim DiaChi As String, eRow As Long, jF As Long
Dim MyRng As Range, Rng As Range, RngDM As Range
Dim OldText As String
Application .ScreenUpdating = False
With Sheets("Index")
eRow = .[a1000].End(xlUp).Row - 1
Set RngDM = .Range(.Cells(2, 1), .Cells(eRow, "C"))
End With
Sheets("Data").Select
Columns("B:B").ClearComments
Columns("A:D").ClearFormats: eRow = [a65000].End(xlUp).Row
Range(Cells(2, 3), Cells(eRow, 4)).ClearContents
Set MyRng = Range([B2], Cells(eRow, 2))
For jF = 1 To eRow
OldText = RngDM.Cells(jF)
With MyRng
Set Rng = .Find(What:=OldText, LookIn:=xlValues, LookAt:=xlWhole)
If Not Rng Is Nothing Then
DiaChi = Rng.Address
Do
With Rng
If .Value = "A1" Then
With .Offset(0, -1).Resize(, 4).Font
.ColorIndex = 5: .Bold = True
End With
.AddComment: .Comment.Visible = False
.Comment.Text Text:="GPE:" & Chr(10) & "OK"
End If
.Offset(, 1).Value = RngDM.Cells(jF).Offset(, 1)
With .Offset(, 2)
.Value = RngDM.Cells(jF).Offset(, 2)
.NumberFormat = "#,##0"
End With
End With
Set Rng = .FindNext(Rng)
If Rng Is Nothing Then Exit Sub
Loop While Not Rng Is Nothing And Rng.Address <> DiaChi
End If
End With
Next
Set RngDM = Nothing: Set MyRng = Nothing
End SubWith MyRng
Set Rng = .Find(What:=OldText, LookIn:=xlValues, LookAt:=xlWhole)
If Not Rng Is Nothing Then
...
End WithSub MyFind()
Dim r As Long, rW As Long, rF1 As Long, rF2 As Long, S As Long
Dim sFind
On Error Resume Next
Columns("B").ClearContents
r = 1
sFind = InputBox("Nhap du lieu tim:")
rF1 = [COLOR=Red][B]Columns("A")[/B][/COLOR].Find(What:=sFind, After:=Cells(1, 1)).Row
If rF1 = 0 Then Exit Sub
rF2 = rF1
Do
Cells(r, 2) = Cells(rF2, 1)
r = r + 1
rF2 = Columns("A").Find(What:=sFind, After:=Cells(rF2, 1)).Row
If rF2 <= rF1 Then Exit Do
Loop
End SubCách của thầy Long cũng như cách khác, đều dùng vòng lặp Do . . . Loop cả mà!
Sub Find_Sun()
Dim lCount As Long '(Ozgrid.com)
Dim rFoundCell As Range
Set rFoundCell = Range("A1")
For lCount = 1 To WorksheetFunction.CountIf(Columns(1), "Sun")
Set rFoundCell = Columns(1).Find(What:="Sun", After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
With rFoundCell.Offset(, 2)
.Value = rFoundCell
.ClearComments
.AddComment Text:="Ozgrid.com"
End With
Next lCount
End Sub
Loop While Not Rng Is Nothing And Rng.Address <> DiaChiFor lCount = 1 To WorksheetFunction.CountIf(Columns(1), "Sun")Cám ơn lời gợi ý, nhờ vậy mình mới tìm thấy cái hay của find. Các bạn xem thử code sau, tìm trong A, B, C có những cell nào có "ch". Ta chọn thử MyRng là 3 cột A, B, C
Sub Find_CaiGiDo()
Dim lCount As Long '(Ozgrid.com)
Dim rFoundCell As Range, MyRng As Range, Dem As Long
Set MyRng = Sheet2.Range(Cells(1, 1), Cells(25, 3))
MyRng.ClearComments
Set rFoundCell = Range("A1")
Dem = WorksheetFunction.CountIf(MyRng, "*ch*")
For lCount = 1 To Dem
Set rFoundCell = MyRng.Find(What:="ch", After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
With rFoundCell
.Value = rFoundCell
.ClearComments
.AddComment Text:="Ozgrid.com"
End With
Next lCount
End SubSearchOrder:=xlByColumns hay là
Đúng là thiếu. Lúc chạy thử đang đã chọn cột A nên nó chạy tốt nhờ Selection.Find ...
rF1 = column(1).Find(What:=sFind, After:=Cells(1, 1)).Row tìm ô đầu tiên thỏa mãn điều kiện tìm thì After:=Cells(1, 1) thừa.
Sub TaoPN()
Dim iRow As Long, EndR As Long
Dim MyRng As Range, rFoundCell As Range, SoCT As String
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Sheets("PhNK").Select
[a14:i27].ClearContents
[C6:C8].ClearContents
SoCT = [H5]
With Sheets("BKNhap")
EndR = .[a65000].End(xlUp).Row
Set MyRng = .Range(.Cells(1, 5), .Cells(EndR, 5)) 'Sửa 2 thành 1'
EndR = WorksheetFunction.CountIf(MyRng, SoCT)
Set rFoundCell = MyRng(1)
Set rFoundCell = MyRng.Find(What:=SoCT, After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=True)
With rFoundCell
Cells(4, 4) = .Offset(iRow, -4).Value
Cells(6, 3) = .Offset(iRow, 1).Value
Cells(8, 3) = "Nhap theo HD" & .Offset(iRow, -1).Value
For iRow = 0 To EndR - 1
Cells(iRow + 14, 1) = iRow + 1
Cells(iRow + 14, 2) = .Offset(iRow, 2).Value
Cells(iRow + 14, 3) = .Offset(iRow, 3).Value
Cells(iRow + 14, 4) = .Offset(iRow, 7).Value
Cells(iRow + 14, 6) = .Offset(iRow, 4).Value
Cells(iRow + 14, 7) = .Offset(iRow, 5).Value
Cells(iRow + 14, 8) = .Offset(iRow, 6).Value
Cells(iRow + 14, 9) = "HD" & .Offset(iRow, -1).Value
Next
End With
End With
Set MyRng = Nothing
Set rFoundCell = Nothing
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End SubSub Find_Format1()
Dim lCount As Long
Dim rFoundCell As Range, MyRng As Range, Dem As Long
Set MyRng = Sheet1.Range(Cells(1, 1), Cells(50, 1))
MyRng.ClearComments
Set rFoundCell = Range("A1")
Dem = WorksheetFunction.CountIf(MyRng, "sun")
For lCount = 1 To Dem
Set rFoundCell = MyRng.Find(What:="sun", After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
With rFoundCell
If .Font.Bold = True And .Font.ColorIndex = 3 Then
.AddComment Text:="TN"
End If
End With
Next lCount
End Sub
Sub Find_Format()
Dim lCount As Long
Dim rFoundCell As Range, MyRng As Range, Dem As Long
Set MyRng = Sheet1.Range(Cells(1, 1), Cells(50, 1))
MyRng.ClearComments
Set rFoundCell = Range("A1")
Dem = WorksheetFunction.CountIf(MyRng, "sun")
With Application.FindFormat.Font
.FontStyle = "Bold"
.ColorIndex = 3
End With
For lCount = 1 To Dem
Set rFoundCell = MyRng.Find(What:="sun", After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, searchFormat:=True)
On Error Resume Next
With rFoundCell
.AddComment Text:="Tim thay roi TN oi!"
End With
Next lCount
End Sub
Set Rng = Selection.Find("*1*", LookIn:=xlValues, LookAt:=xlWhole)expression: Required. An expression that returns a Range object.
Cells.Find(What:="SUN", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False).ActivateSub TestFind()
With Worksheets("Sheet1").Range("A1:A500")
Set Rng = .Find(2, LookIn:=xlValues)
If Not Rng Is Nothing Then ‘Nếu giá trị Rng trả về không phải là Nothing thì
firstAddress = Rng.Address ‘Lưu lại địa chỉ ô đầu tiên tìm được.
Do
Rng.Value = 5
Set Rng = .FindNext(Rng) ‘Tìm tiếp
Loop While Not Rng Is Nothing And Rng.Address <> firstAddress
‘Dừng vòng lặp Do..Loop khi giá trị Rng trả về là Nothing hoặc
‘địa chỉ Rng trả về trùng với địa chỉ của ô tìm được đầu tiên.
End If
End With
End Sub
