Chào các Anh/Chị
em là dân ngoại đạo mò mẫm ghép nối lại được code phù hợp cho nhu cầu công việc của mình, nhưng mới chỉ mò được tìm kiếm ở 1 sheet cụ thể thôi, e ko biết làm sao để sửa tìm kiếm trong tất cả các sheet, nên mong được giúp đỡ ạ. PS: Em ko biết có phải up file lên ko ạ?
em là dân ngoại đạo mò mẫm ghép nối lại được code phù hợp cho nhu cầu công việc của mình, nhưng mới chỉ mò được tìm kiếm ở 1 sheet cụ thể thôi, e ko biết làm sao để sửa tìm kiếm trong tất cả các sheet, nên mong được giúp đỡ ạ. PS: Em ko biết có phải up file lên ko ạ?
Mã:
Sub Find_First()
Dim FindString As String
Dim Rng As Range
Dim FistAddress As String
Dim LastAddress As String
Dim Result As Range
Dim ws As Worksheet
Dim firstAdd As String
' Xóa dong trong trong sheet NET
Sheets("NET").Select
Range("A4").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
'Tim gia tri dau tien
FindString = InputBox("May Can Tim Kiem Cai Gi:", "Tra Cuu So Do Mang Luoi")
If Trim(FindString) <> "" Then
With Sheets("Sheet1").Range("C:D")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
firstAdd = Rng.Address
If Not Rng Is Nothing Then
Application.Goto Rng, True
Cells(Rng.Row, 13).Value = 1
FistAddress = Rng.Row
Else
MsgBox "Nothing found"
End If
End With
'Tim gia tri cuoi cung
With Sheets("Sheet1").Range("C:D")
Do
Set Rng = .Find(What:=FindString, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not Rng Is Nothing Then
'Rng = Cells(LastAddress, 3)
'Set Rng = .FindNext(Rng)
Application.Goto Rng, True
Cells(Rng.Row, 13).Value = 2
LastAddress = Rng.Row
'MsgBox Cells(Rng.Row, 11)
'MsgBox Cells(Rng.Row, 3)
Set Rng = Cells(LastAddress, 3)
Set Rng = .FindNext(Rng)
FindString = Cells(LastAddress, 3)
Else
MsgBox "Nothing found"
End If
Loop While firstAdd <> Rng.Address And Cells(Rng.Row, 11) > 600
'Copy sang Sheet NET
Set Result = Range(Cells(FistAddress, 1), Cells(LastAddress, 12))
Result.Select
Selection.Copy Destination:=Sheets("NET").Range("A4")
Sheet23.Activate
End With
End If
End Sub
Lần chỉnh sửa cuối: