search entire Excel workbook for text string and highlight cell

前端 未结 2 1155
慢半拍i
慢半拍i 2021-01-29 14:40

I need to search an entire Excel workbook containing multiple sheets for text strings that may be present in multiple columns (say in the range column A to column

2条回答
  •  傲寒
    傲寒 (楼主)
    2021-01-29 15:11

    This code, based on the first set of code you posted, will highlight all occurrences of whatever text you type in within the workbook.

    Public Sub find_highlight()
    
        'Put Option Explicit at the top of the module and
        'Declare your variables.
        Dim FindString As String
        Dim wrkSht As Worksheet
        Dim FoundCell As Range
        Dim FirstAddress As String
    
        FindString = InputBox("Information")
    
        'Use For...Each to cycle through the Worksheets collection.
        For Each wrkSht In ThisWorkbook.Worksheets
            'Find the first instance on the sheet.
            Set FoundCell = wrkSht.Cells.Find( _
                What:=FindString, _
                After:=wrkSht.Range("A1"), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
            'Check it found something.
            If Not FoundCell Is Nothing Then
                'Save the first address as FIND loops around to the start
                'when it can't find any more.
                FirstAddress = FoundCell.Address
                Do
                    With FoundCell.Interior
                        .ColorIndex = 6
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                    End With
                    'Look for the next instance on the same sheet.
                    Set FoundCell = wrkSht.Cells.FindNext(FoundCell)
                Loop While FoundCell.Address <> FirstAddress
            End If
    
        Next wrkSht
    
    End Sub
    

    To find more than one value and format you could use the following code.
    It relies on a sheet I've called Info which has the values to look for in the range A1:A3.
    The background to these values have been coloured as you want and the code just finds the matching values and copies the colour over.

    You could add extra code to allow for more values, or use a dynamic named range to return your source values.
    A dynamic named range would consist of a formula such as: =Info!$A$1:INDEX(Info!$A:$A,COUNTA(Info!$A:$A)) with a given name of 'SourceValues'.
    Select Define Name on the Formula ribbon and paste the formula into the Refers To: box and the SourceValues into the name.

    You'd then refer to the range with Set Information = Range("SourceValues")

    Public Sub find_highlight()
    
        'Put Option Explicit at the top of the module and
        'Declare your variables.
        Dim FindString As String
        Dim wrkSht As Worksheet
        Dim FoundCell As Range
        Dim FirstAddress As String
        Dim InfoBit As Range
        Dim Information As Range
    
        Set Information = Range("SourceValues")
        'Set Information = ThisWorkbook.Worksheets("Info").Range("A1:A3")
    
        'Use For...Each to cycle through the information we're looking for.
        For Each InfoBit In Information
            'Use For...Each to cycle through the Worksheets collection.
            For Each wrkSht In ThisWorkbook.Worksheets
                'Ignore the "Info" sheet as it holds our values to search for.
                If wrkSht.Name <> "Info" Then
                    'Find the first instance on the sheet.
                    Set FoundCell = wrkSht.Cells.Find( _
                        What:=InfoBit, _
                        After:=wrkSht.Range("A1"), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
                    'Check it found something.
                    If Not FoundCell Is Nothing Then
                        'Save the first address as FIND loops around to the start
                        'when it can't find any more.
                        FirstAddress = FoundCell.Address
                        Do
                            'Copy all formatting - bit of screen flicker.
    '                        InfoBit.Copy
    '                        FoundCell.PasteSpecial Paste:=xlPasteFormats
    
                            'Just copy the Interior colour.
                            FoundCell.Interior.Color = InfoBit.Interior.Color
    
                            'Look for the next instance on the same sheet.
                            Set FoundCell = wrkSht.Cells.FindNext(FoundCell)
                        Loop While FoundCell.Address <> FirstAddress
                    End If
                End If
            Next wrkSht
        Next InfoBit
    
    End Sub
    

提交回复
热议问题