Asignarle color a varias celdas condicionadas teniendo múltiples registros en una hoja de excel mediante código VBA

Llevo ya varios días trabajando en esto e intentado lograr lo siguiente soy nuevo en esto pero ya he logrado cosas importantes y he podido avanzar. Tengo un archivo en el cual me muestra muchos registros provenientes de un proceso, este archivo ya lo he convertido de formato CSV a excel, ahora necesito que a través de un formulario y mediante algunos textbox (dependiendo de los valores que contiene los registros pueden ser hasta 10 textbox ), me busque el determinado valor que contiene cada textbox, y a partir de hay le de un color a cada celda que contenga dicho valor, pero debo de condicionarlo porque puedo tener un mismo valor repetido mucho más abajo dentro del registro y si es así debo de darle un color a las celdas distinto a el color que se le ha asignado al mismo valor anterior, a continuación adjunto fotos para una mejor guía

Me refiero exactamente a la columna C es una lista de múltiples registros los cuales no son estáticos sino dinámicos en pocas palabras que nunca voy a tener un valor fijo de columnas ese valor de columnas puede variar.

Como se puede observar en el registro de la fila 1419 columna C es que hay un cambio de valor y de hay en adelante se repetirá el mismo valor y le debo asignar un color distinto a las celdas que contienen este valor.

Este registro específicamente contendrá múltiples valores de la siguiente manera;

0,20,40,60 de nuevo 60,40,20 y 0 organizados ascendentemente y descendentemente

Aquí se observa que en la celda 2838 columna C el registro cambia de nuevo y esta vez fue a 40 y así sucesivamente más abajo el registro cambiara a 60.

Ya he logrado asignarle color a cada uno de los valores mediante un formulario al ejecutar varias macros.

y el resultado es el siguiente en la hoja

Se preguntaran que porque la columna "A" también quedo de color verde, esto lo logro gracias al valor que se le da dentro del formulario al textbox que dice tiempo estable, esto me permitirá luego copiar las filas que contienen el mismo color en la columna A Y C y llevarlas a una nueva hoja, así sucederá con todos los otros valores.

y esto es lo que copio a la otra hoja

Hasta aquí me funciona a la perfección pero de aquí en adelante es donde viene mi problema cuando necesito hacer lo mismo que les vine explicando pero cuando necesito darle color a los valores que están organizados de 60, 40, 20 y 0 descendentemente en el registro, porque de la manera en el que he creado el código me asigna el color a todos los registros que encuentra de una vez que tienen el mismo valor y no tengo en cuenta que más abajo se puede volver a tener el mismo valor y tengo que asignarle otro color distinto y a esto es lo que me refiero en el comienzo de esta descripción. "pero debo de condicionarlo porque puedo tener un mismo valor repetido mucho más abajo dentro del registro y si es así debo de darle un color a las celdas distinto a el color que se le ha asignado al mismo valor anterior"

Se genera el siguiente error.

Les agradecería si me pueden colaborar puedo compartirles el código, soy nuevo en esto y ya llevo varios días tratando de corregir este problema para así poder culminar con este código.

1 Respuesta

Respuesta

Yo haría la separación con esta macro, la cual lee los datos en la hoja datos y mediante un filtro los separa en la resultados por valor, coloreando en la tabla de la hoja datos

y esta es la macro

Sub colorearycopiar()
INICIO = Time
Set H1 = Worksheets("DATOS")
Set H2 = Worksheets("RESULTADOS")
Set DATOS = H1.Range("A27").CurrentRegion
H2.Cells.Clear
H1.Cells.Interior.ColorIndex = xlNone
With DATOS
    FILAS = .Rows.Count
    COL = .Columns.Count
    Set TABLA = .Columns(COL + 8).Resize(FILAS, 1)
End With
With TABLA
    .Columns(1).Value = DATOS.Columns(3).Value
    .RemoveDuplicates Columns:=1
    .Sort KEY1:=H1.Range(.Columns(1).Address), ORDER1:=xlAscending, Header:=True
    For I = 2 To .CurrentRegion.Rows.Count
        VALOR = .Cells(I)
        If I = 2 Then LETRA = "A": XCOLOR = 4
        If I = 3 Then LETRA = "E": XCOLOR = 5
        If I = 4 Then LETRA = "I": XCOLOR = 6
        If I = 5 Then LETRA = "M": XCOLOR = 7
        DATOS.AutoFilter 3, VALOR
        DATOS.Offset(1).Resize(.Rows.Count - 1).Interior.ColorIndex = XCOLOR
        DATOS.Offset(1).Resize(.Rows.Count - 1).Copy
        H2.Range(LETRA & 2).PasteSpecial
        DATOS.AutoFilter
    Next I
    Set RESULTADOS = H2.Range("A2").CurrentRegion
    With RESULTADOS
        COL = .Columns.Count
        For I = 1 To COL
            CUENTA = WorksheetFunction.CountA(.Columns(I * 2))
            If CUENTA > 0 Then
                .Columns(I * 2).Resize(CUENTA).Interior.ColorIndex = 46
            Else
                .Columns(I * 2).Interior.ColorIndex = 46
            End If
        Next I
        DATOS.Rows(1).Copy: .Rows(0).PasteSpecial
        .Rows(0).Font.Bold = True
    End With
End With
With DATOS
    Union(.Columns(2), .Columns(4)).Interior.ColorIndex = xlNone
End With
TABLA.Clear
Set H1 = Nothing: Set H2 = Nothing
Set DATOS = Nothing: Set TABLA = Nothing: Set RESULTADOS = Nothing
FIN = Time
TIEMPO = FIN - INICIO
TIEMPO = Format(TIEMPO, "HH:MM:SS")
MsgBox (FILAS & " PROCESADAS EN " & TIEMPO), vbExclamation, "AVISO"
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas