如果列A中的值是x,则突出显示行

如果column A = X文本,如何突出显示一行颜色

以第4行为例:我最终想要得到的是,如果列A中的单元格是= X那么将行的颜色从Range("B4:N4")更改为黑色 And Text.Color Range("F4:N4") 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 

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 

在这里输入图像说明

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

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

一次select一个范围,然后从主页选项卡创build一个新的条件格式规则,select使用公式,然后input一个公式,如:

 =$A2="X" 

请注意,在条件格式中使用相对/混合引用时,它将与您正在使用的范围中的第一个单元格进行比较。 我已经select范围B2:N7来应用格式化,所以需要创build混合引用,因为它应该应用于B2单元格。 您看不到它,但是对于同一范围内的所有其他单元格,引用会自动更改,就像您在其他范围内填充公式一样。 例如,K5单元格的格式将取决于$ A5中的值(因为列引用是固定的,但行参考是dynamic的)。

然后为指定范围设置所需的背景颜色或字体颜色。 这个条件将检查相应行的列A.

图

我重新写了一些你的代码,并添加了评论,告诉你为什么。 但总的来说,我遵循了原来的方法。

 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