search工具在Excel中，VBA

我是excel VBA的新手，我真的需要帮助来扩展我的代码。 代码在所有工作表中search文本。 我想列出所有的search结果在第一个工作表中find文本的完整行。 不幸的是，我不知道如何复制find标准的行。 也许如果我能得到一个解决scheme来检查代码将是一个很大的帮助。

Sub SearchAllSheets() Dim ws As Worksheet Dim rFound As Range Dim strName As String On Error Resume Next strName = InputBox("What are you looking for?") If strName = "" Then Exit Sub For Each ws In Worksheets 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 Exit Sub End If End With Next ws On Error GoTo 0 MsgBox "Value not found" 

结束小组

Answer 1

我想你正在寻找所有表单中的所有事件的文本。 试试这个代码：

 Sub SearchAllSheets() Dim ws As Worksheet, OutputWs As Worksheet Dim rFound As Range, FirstAddress Dim strName As String Dim count As Long, LastRow As Long Dim IsValueFound As Boolean IsValueFound = False Set OutputWs = Worksheets("Output") '---->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 FirstAddress = rFound.Address Do Application.Goto rFound, True IsValueFound = True 'MsgBox rFound.Row Debug.Print rFound.Address rFound.EntireRow.Copy OutputWs.Cells(LastRow + 1, 1).PasteSpecial xlPasteAll Application.CutCopyMode = False LastRow = LastRow + 1 Set rFound = .FindNext(rFound) Loop While Not rFound Is Nothing And rFound.Address <> FirstAddress 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 

Answer 2

下面的代码将粘贴行的数据发现表Output 。 代码将不会search结果的Output表。

 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("Output") '---->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