Hola a todos,

Llevo un buen rato con un pequeño error, y no veo la forma de subsanarlo.
Tengo una tabla donde en la columna A hay distintos valores ( pero se pueden repetir ), lo que intento hacer es aplicar formatos a las celdas por cada grupo donde las celdas sean distintas.
Son 2 colores , solo me interesa que visualmente se vean los que son iguales.
Ejemplo:

Columna A.
01.01 Aplico Color 1
01.02 Aplico Color 2
01.03 Aplico Color 1
01.03 Aplico Color 1
01.03 Aplico Color 1

Este es el código que estoy usando, pero cuando llega a los repetidos no consigo controlar que no cambie de color.
 

Sub FormatosDescompuestos()
Dim Wb As Workbook
Dim ws As Worksheet
Dim ColorFilaP, ColorFilaI
Dim Celda1, celda2
Dim TipoColor
Dim Filas
Set Wb = ThisWorkbook
Set ws = Wb.Sheets("Descompuestos")
ColorFilaP = 35
ColorFilaI = 40
ws.Activate
ws.Select
'ws.Unprotect Password:="0"
'
Filas = ws.Columns("A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
TipoColor = 1
j = 2
'
ActiveSheet.Range("A2").Select
For h = 2 To Filas
i = j + 1
Set Celda1 = ws.Cells(h, 1)
Set celda2 = ws.Cells(j, 1)
Do Until celda2 <> Celda1
  Set Fila = ws.Range("A" & h & ":" & "R" & j)
  Fila.Select
  Fila.RowHeight = 12
        If TipoColor = 1 Then
            Fila.Interior.ColorIndex = ColorFilaP
            TipoColor = 2
        Else
            Fila.Interior.ColorIndex = ColorFilaI
            TipoColor = 1
        End If
        j = j + 1
        Set celda2 = ws.Cells(j, 1)
    Loop
Next h
End Sub

 

Ejemplo Formato agrupado.xlsm

Usa...

Sub PintaCambio()
Dim Celda As Range, Valor, TC&
    Valor = Range("A2")
    TC = 1
    For Each Celda In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
        If Celda <> Valor Then
            Valor = Celda.Value
            If TC = 1 Then TC = 2 Else TC = 1
        End If
        If TC = 2 Then
            Range("A" & Celda.Row & ":R" & Celda.Row).Interior.ColorIndex = 35
        Else
            Range("A" & Celda.Row & ":R" & Celda.Row).Interior.ColorIndex = 40
        End If
    Next Celda
End Sub

Saludos

Hace 36 minutos , Leopoldo Blancas dijo:

Usa...

Sub PintaCambio()
Dim Celda As Range, Valor, TC&
    Valor = Range("A2")
    TC = 1
    For Each Celda In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
        If Celda <> Valor Then
            Valor = Celda.Value
            If TC = 1 Then TC = 2 Else TC = 1
        End If
        If TC = 2 Then
            Range("A" & Celda.Row & ":R" & Celda.Row).Interior.ColorIndex = 35
        Else
            Range("A" & Celda.Row & ":R" & Celda.Row).Interior.ColorIndex = 40
        End If
    Next Celda
End Sub

Saludos

¿Y porqué en lugar de utilizar los valores 1 y 2 para la variable TC, no usas los valores 35 y 40 y utilizas la propia variable como color?

Hace 2 minutos , Antoni dijo:

¿Y porqué en lugar de utilizar los valores 1 y 2 para la variable TC, no usas los valores 35 y 40 y utilizas la propia variable como color?

Es para que el consultante le entienda mejor... o esperamos el ejemplo en Power Query... a ver si así le entiende el consultante???

Como vez @Antoni??? esperamos o hacemos el cambio?

Bueno... @Antoni, para dar otro ejemplo con With y con tu recomendación... Para que vuelvas a soñar con VBA...

Sub FormatosDescompuestos()
Dim TipoColor, Celda, Filas&, n&
    Application.ScreenUpdating = False
    With ThisWorkbook.Sheets("Hoja1")
        TipoColor = 35
        Celda = .Range("A2")
        For n = 2 To .Range("A2").CurrentRegion.Rows.Count
            If Celda <> .Cells(n, "A") Then
                Celda = .Range("A" & n)
                If TipoColor = 35 Then TipoColor = 40 Else TipoColor = 35
            End If
            .Range("A" & n & ":R" & n).Interior.ColorIndex = TipoColor
        Next n
    End With
    Application.ScreenUpdating = True
End Sub

Saludos a Ambos!!!

@Antoni ahiiiiii vvvvvvvaaaaaaaaaaaaaaaaaaa..............aaaaaaa

Sub PintaCambio()
Dim Celda As Range, Valor, TC&
    Application.ScreenUpdating = False
    Valor = Range("A2")
    TC = 35
    For Each Celda In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
        If Celda <> Valor Then
            Valor = Celda.Value
            If TC = 35 Then TC = 40 Else TC = 35
        End If
        Range("A" & Celda.Row & ":R" & Celda.Row).Interior.ColorIndex = TC
    Next Celda
    Application.ScreenUpdating = True
End Sub

 

Muchas gracias a los dos, realmente me habéis sorprendido con la facilidad que lo habéis resuelto.

Yo llevaba toda la tarde con ello y no había forma.

Gracias,

Se podría añadir la funcion .BorderAround en cada cambio para que se pudiese ver mejor cada grupo?, lo he intentado pero me lo hace en cada fila ( No sabría como modificar esto ).

 

Gracias,