vba excel以黄色突出显示单元格

Question

How can highlight in yellow a cell that have a specific word in it?
I have data in colum B and F with the word "No Game".
How can I have this in a vba in excel?

Thanks

Answer 1

Although this question has already been answered, I'd take my chance, showing how easy this is using conditional formatting (screenshots are minimised a bit):

Result looks like this:

Good luck

Answer 2

Highlight Matches ( For Each...Next )

• Copy the complete code into a standard module, eg Module1 .
• Adjust (play with) the values in the constants section.

Option Explicit

Sub HighlightColumns()
' Needs the 'RefColumn' and 'RefCombinedRange' functions.
    Const ProcTitle As String = "Highlight Columns"

    Const wsName As String = "Sheet1"
    Const FirstCellsList As String = "B2,H2"
    Const hCriteria As String = "No Game"
    Const hColor As Long = vbYellow
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    
    ' Write the list of the first cells' addresses to an array ('FirstCells').
    Dim FirstCells() As String: FirstCells = Split(FirstCellsList, ",")
    
    Dim scrg As Range ' Source Column Range
    Dim sfCell As Range ' Source First Cell
    Dim sCell As Range ' Source Cell
    Dim hrg As Range ' Highlight Range
    Dim n As Long ' Columns Counter
    
    ' Combine all matching cells into the Highlight Range.
    For n = 0 To UBound(FirstCells)
        Set sfCell = ws.Range(FirstCells(n))
        Set scrg = RefColumn(sfCell)
        If Not scrg Is Nothing Then ' found data in column range
            For Each sCell In scrg.Cells
                If StrComp(CStr(sCell.Value), hCriteria, vbTextCompare) = 0 Then
                    Set hrg = RefCombinedRange(hrg, sCell)
                'Else ' not a match
                End If
            Next sCell
            Set scrg = Nothing
        'Else ' no data in current column range
        End If
    Next n
    
    ' Highlight and inform.
    If Not hrg Is Nothing Then ' Highlight Criteria found
        hrg.Interior.Color = hColor
        MsgBox "Highlighted cells equal to '" & hCriteria & "'.", _
            vbInformation, ProcTitle
    Else ' no Highlight Criteria found
        MsgBox "No occurrences of '" & hCriteria & "' found.", _
            vbExclamation, ProcTitle
    End If
    
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Creates a reference to the one-column range from the first cell
'               of a range ('FirstCell') to the bottom-most non-empty cell
'               of the first cell's worksheet column.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefColumn( _
    ByVal FirstCell As Range) _
As Range
    If FirstCell Is Nothing Then Exit Function
    
    With FirstCell.Cells(1)
        Dim lCell As Range
        Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then Exit Function
        Set RefColumn = .Resize(lCell.Row - .Row + 1)
    End With

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Creates a reference to a range combined from two ranges.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefCombinedRange( _
    ByVal CombinedRange As Range, _
    ByVal AddRange As Range) _
As Range
    If CombinedRange Is Nothing Then
        Set RefCombinedRange = AddRange
    Else
        Set RefCombinedRange = Union(CombinedRange, AddRange)
    End If
End Function