Question

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

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"

End Sub

Answer 1

下面的代码会将包含找到的数据的行粘贴到工作表Output。代码不会在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

Answer 2

我猜您正在寻找所有工作表中所有匹配项的文本。试试这段代码：

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

在excel中搜索工具，vba

2 个答案: