如果 A 列中的值为 x，则突出显示行

Question

如果 column A = X

中的文本，如何用颜色突出显示单行

以第4行为例：我最终想要得到的是，如果 A 列中的单元格为 = X，则将行颜色从 Range("B4:N4") 更改为 Black And Text.Color 为白色来自 Range("F4:N4")

最终我希望它像 Range(Cells(i, "B"), Cells(LastRow, LastCol)) 但只有一行颜色。

这是我目前正在使用的。

Sub Header()
    Application.ScreenUpdating = False

    Dim sht2 As Worksheet
    Set sht2 = ThisWorkbook.Worksheets("Email Form")

    sht2.Activate
    sht2.Unprotect

    Dim LastRow As Long, LastCol As Long
    Dim rng As Range, c As Range
    Dim WholeRng As Range
    Dim i As Integer

    On Error GoTo 0

    With sht2
        Set rng = .Cells

        LastRow = rng.Find(What:="*", After:=rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row

        LastCol = rng.Find(What:="*", After:=rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column

        'MsgBox wholerng.Address
        Set WholeRng = Range(Cells(i, "B"), Cells(LastRow, LastCol)).Rows

        For i = 4 To LastRow
            If sht2.Cells(i, 1).Value = "X" Then
            With WholeRng
                With .Interior
                .PatternColorIndex = xlAutomatic
                .Color = 1
                .TintAndShade = 0
                .Font.Color = 0
                End With
            End With
            End If
        Next i

        Dim b As Boolean
        For Each rng In WholeRng.Rows
            If Not rng.Hidden Then
                If b Then rng.Interior.Color = 1
                b = Not b
            End If
        Next
    End With

    Set sht2 = Nothing
    Set rng = Nothing
    Set WholeRng = Nothing
    Application.ScreenUpdating = False
End Sub

Answer 1

我认为您可以使用条件格式来实现您的目标：

您可以为两个不同范围的每个格式设置创建一个条件。

Select 一次一个范围，然后从主页选项卡创建一个新的条件格式规则，选择使用公式，然后输入如下公式：

=$A2="X"

请注意，在条件格式中使用 relative/mixed 引用时，它将与您正在使用的范围内的第一个单元格进行比较。我选择了要应用格式的范围 B2:N7，因此需要创建混合引用，因为它应该应用于 B2 单元格。您看不到它，但同一区域中所有其他单元格的引用会自动更改，就像您在该区域的其余部分填充公式一样。例如，K5 单元格的格式将取决于 $A5 中的值（因为列引用是固定的，但行引用是动态的）。

然后为指定的范围设置你想要的背景颜色或字体颜色。此条件将检查相应行的 A 列。

Answer 2

VBA 条件格式。

Option Explicit

Sub Header()

    Dim sht2 As Worksheet
    Dim firstRow As Long, lastRow As Long, lastCol As Long

    'Application.ScreenUpdating = false
    On Error GoTo 0
    Set sht2 = ThisWorkbook.Worksheets("Email Form")
    firstRow = 4

    With sht2
        .Activate
        .Unprotect

        lastRow = .Cells.Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
        lastCol = .Cells.Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column

        'black row, white text B:N
        With .Range(.Cells(firstRow, "B"), .Cells(lastRow, lastCol))
            'optionally remove any pre-existing CFRs
            .FormatConditions.Delete
            With .FormatConditions.Add(Type:=xlExpression, Formula1:="=UPPER($A4)=CHAR(88)")
                .Interior.ThemeColor = xlThemeColorLight1
                .Font.ThemeColor = xlThemeColorDark1
                .SetFirstPriority
                .StopIfTrue = False
            End With
        End With
        'don't display values from B:E
        With .Range(.Cells(firstRow, "B"), .Cells(lastRow, "E"))
            With .FormatConditions.Add(Type:=xlExpression, Formula1:="=UPPER($A4)=CHAR(88)")
                .NumberFormat = ";;;"
            End With
        End With

        'I tnhink you want to reProtect the worksheet here
        .Protect
    End With


    Application.ScreenUpdating = True
End Sub

Answer 3

我重写了您的一些代码并添加了注释以说明原因。但总的来说，我遵循了你原来的方法。

Sub Header()

    Dim Sht2 As Worksheet
    Dim LastRow As Long, LastCol As Long
    Dim IsBlack As Boolean, FillPattern As Long
    Dim Rng As Range
    Dim R As Long

'    Set sht2 = ThisWorkbook.Worksheets("Email Form")
    Set Sht2 = ThisWorkbook.Worksheets("Taylor")
'    On Error GoTo 0                     ' this is the default: no need to set
    Application.ScreenUpdating = False

    With Sht2
        .Activate                       ' no need to activate this sheet
        .Unprotect
        ' this is the whole sheet: Easier to refer to it as .Cells
        ' Set rng = .Cells
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
'        LastRow = Rng.Find(What:="*", After:=Rng.Cells(1), Lookat:=xlPart, _
'                           LookIn:=xlFormulas, SearchOrder:=xlByRows, _
'                           SearchDirection:=xlPrevious, MatchCase:=False).Row
'        LastCol = Rng.Find(What:="*", After:=Rng.Cells(1), Lookat:=xlPart, _
'                           LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
'                           SearchDirection:=xlPrevious, MatchCase:=False).Column
'        MsgBox "Last row = " & LastRow & vbCr & _
'               "Last column = " & LastCol

        For R = 4 To LastRow
            IsBlack = Not CBool(StrComp(.Cells(R, 1).value, "X", vbTextCompare))
            FillPattern = CLng(Array(xlNone, xlSolid)(Abs(IsBlack)))
            Set Rng = .Range(.Cells(R, 1), .Cells(R, LastCol))
            With Rng.Interior
                If .Pattern <> FillPattern Then
                    .Pattern = FillPattern
                    If IsBlack Then
                        .PatternColorIndex = xlAutomatic
                        .ThemeColor = xlThemeColorLight1
                    End If
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                    Rng.Font.ColorIndex = Array(xlAutomatic, 2)(Abs(IsBlack))
                End If
            End With
        Next R
    End With

    ' VBA does this cleanup automatically at the end of the sub
'    Set sht2 = Nothing
'    Set Rng = Nothing
    Application.ScreenUpdating = False
End Sub

如果 A 列中的值为 x，则突出显示行

Highlight rows if value in column A is x

excel

vba

conditional-formatting