[英]VBA excel search tool
Tried doing a search tool to the excel sheet (VBA) I'm working on.尝试对我正在处理的 excel 工作表(VBA)进行搜索工具。 So far every time I search for the text, it ends up filtering only the first row and not any row that has the value I'm looking for.到目前为止,每次我搜索文本时,它最终只过滤第一行,而不是任何具有我正在寻找的值的行。 I added a picture to show what it returns and the code as well.我添加了一张图片来显示它返回的内容以及代码。 Is there anything I need to change to the code to make it search for all the data in the sheet instead of having it to show only one row?我需要更改代码以使其搜索工作表中的所有数据而不是只显示一行吗? Any help is appreciated.任何帮助表示赞赏。
Search result of only the first row:仅第一行的搜索结果:
Sub SearchAllSheets()
Dim ws As Worksheet, OutputWs As Worksheet
Dim rFound As Range
Dim strName As String
Dim count As Long, LastRow As Long
Dim IsValueFound As Boolean
IsValueFound = False
Set OutputWs = Worksheets("sheet1") '---->change the sheet name as required
LastRow = OutputWs.Cells(Rows.count, "A").End(xlUp).Row
On Error Resume Next
strName = InputBox("What are you looking for?")
If strName = "" Then Exit Sub
For Each ws In Worksheets
If ws.Name <> "Output" Then
With ws.UsedRange
Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
If Not rFound Is Nothing Then
Application.Goto rFound, True
IsValueFound = True
'MsgBox rFound.Row
rFound.EntireRow.Copy
OutputWs.Cells(LastRow + 1, 1).PasteSpecial xlPasteAll
Application.CutCopyMode = False
LastRow = LastRow + 1
End If
End With
End If
Next ws
On Error GoTo 0
If IsValueFound Then
OutputWs.Select
MsgBox "Result pasted to Sheet Output"
Else
MsgBox "Value not found"
End If
End Sub
Try this:尝试这个:
Sub SearchAllSheets()
Dim ws As Worksheet, OutputWs As Worksheet
Dim rFound As Range, IsValueFound As Boolean
Dim strName As String
Dim count As Long, LastRow As Long
Set OutputWs = Worksheets("Output") '---->change the sheet name as required
LastRow = OutputWs.Cells(Rows.count, "A").End(xlUp).row
strName = Trim(InputBox("What are you looking for?"))
If strName = "" Then Exit Sub
For Each ws In Worksheets
If ws.Name <> OutputWs.Name Then
Debug.Print "Checking " & ws.Name
Set rFound = FindAll(ws.UsedRange, strName)
If Not rFound Is Nothing Then
Set rFound = rFound.EntireRow
count = rFound.Cells.count / Columns.count 'how many matched rows?
Debug.Print "Found " & count & " rows"
rFound.Copy OutputWs.Cells(LastRow + 1, 1)
LastRow = LastRow + count
IsValueFound = True
End If
End If
Next ws
If IsValueFound Then
OutputWs.Select
MsgBox "Result(s) pasted to Sheet " & OutputWs.Name
Else
MsgBox "Value not found"
End If
End Sub
'find all cells in range `rng` with value `val` and return as a range
Public Function FindAll(rng As Range, val As String) As Range
Dim rv As Range, f As Range
Dim addr As String
Set f = rng.Find(what:=val, After:=rng.Cells(rng.Cells.count), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not f Is Nothing Then addr = f.Address()
Do Until f Is Nothing
If rv Is Nothing Then
Set rv = f
Else
Set rv = Application.Union(rv, f)
End If
Set f = rng.FindNext(After:=f)
If f.Address() = addr Then Exit Do
Loop
Set FindAll = rv
End Function
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.