¿Cómo puedo resaltar una sola fila de un color si el texto en column A = X

Usando la fila 4 como ejemplo: Lo que en última instancia estoy tratando de obtener es si la celda en la columna A es = X y luego cambia el color de la fila de Range("B4:N4") a Negro And Text.Color a Blanco de Range("F4:N4")

En última instancia, me gustaría que fuera algo así como Range(Cells(i, "B"), Cells(LastRow, LastCol)) pero solo el color de una fila.

Esto es con lo que estoy trabajando hasta ahora.

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
1
Matt Taylor 28 abr. 2017 a las 04:35

3 respuestas

La mejor respuesta

Formato condicional de 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

enter image description here

1
28 abr. 2017 a las 02:25

Creo que puede lograr su objetivo con el formato condicional:

Puede crear una condición para cada configuración de formato para los dos rangos diferentes.

Seleccione un rango a la vez, luego, desde la pestaña Inicio, cree una Nueva regla de formato condicional, elija Usar una fórmula y luego ingrese una fórmula como:

=$A2="X"

Tenga en cuenta que cuando utilice referencias relativas / mixtas en formato condicional, se comparará con la primera celda del rango con el que está trabajando. He seleccionado el rango B2: N7 para aplicar el formato, por lo que la referencia mixta debe crearse como debería aplicarse a la celda B2. No puede verlo, pero la referencia cambia automáticamente para todas las demás celdas en el mismo rango, lo mismo que si estuviera completando una fórmula en el resto del rango. Por ejemplo, el formato de la celda K5 dependerá del valor en $ A5 (porque la referencia de columna es fija pero la referencia de fila es dinámica).

Luego configure el color de fondo o el color de fuente que desee para el rango especificado. Esta condición verificará la columna A de la fila correspondiente.

Img

0
Michael 28 abr. 2017 a las 02:02

Reescribí parte de su código y agregué comentarios para mostrarle por qué. Pero en general, seguí tu enfoque original.

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
0
Variatus 28 abr. 2017 a las 02:43