Vba Alternar formatos al cambiar valores en misma columna.
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
'
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
1 respuesta
Este es el resultado de la macro
y esta es la macro
Sub colorear()
Set datos = Range("a2").CurrentRegion
ColorFilaP = 35
ColorFilaI = 40
With datos
c = .Columns.Count: Fi = .Rows.Count
.Columns(1).Copy: .Columns(c + 3).Resize(Fi, 1).PasteSpecial
.Columns(c + 3).Resize(Fi, 1).RemoveDuplicates Columns:=1
.Columns(c + 3).Resize(Fi, 1).CurrentRegion.Select
.RowHeight = 12
End With
With Selection
F = .Rows.Count
TipoColor = 1
For i = 1 To F
numero = .Cells(i, 1)
fila = WorksheetFunction.Match(numero, datos.Columns(1), 0)
If TipoColor = 1 Then
datos.Rows(fila).Interior.ColorIndex = ColorFilaP
TipoColor = 2
Else
datos.Rows(fila).Interior.ColorIndex = ColorFilaI
TipoColor = 1
End If
Next i
.Clear
End With
Set datos = Nothing
End Sub
