Completar macro para sombrear celdas según el valor de otras celdas.

Tengo la siguiente macro. Funciona bien, pero necesito que haga mas cosas que no consigo.

Si en el rango ("B19:AR367") se escribe una de estas iniciales: "V", "L", "S", "AP", "FJ", "VP"

Pintará esa celda según los siguientes criterio:

Si en rango (A, misma fila), está "JS", entonces color 37

Si en rango (A, misma fila), está "DP", entonces color 3

Si en rango (A, misma fila), está "AT", entonces color 4

Si en rango (A, misma fila), está "JO", entonces color 6

Si en rango (A, misma fila), está "JJ", entonces color 39

Si en rango (A, misma fila), está "EN", entonces color 7

Si en rango (A, misma fila), está "RE", entonces color 12

Y si no, so se sombrea nada.

También la hoja, la bloqueo con la contraseña "JS". Necesito que se desbloquee para ejecutar la macro y después que la vuelva a bloquear.

Muchas gracias y un saludo.

Private Sub Worksheet_Change(ByVal Target As Range)
'si se seleccionaron varias al mismo tiempo no ejecuta (solo se les quita color)
If Target.Count > 1 Then Target.Interior.ColorIndex = xlNone: Exit Sub
'en cualquiera de las filas, si es vacío se quita color y finaliza
If Target = "" Then
    Target.Interior.ColorIndex = xlNone
    Exit Sub
End If
    'según el texto va el color - ya controlé al inicio que si dejo vacía le quite color
    If Target.Value = "JS" Then
        Target.Interior.ColorIndex = 37   'azul
    ElseIf Target.Value = "DP" Then
        Target.Interior.ColorIndex = 3   'Rojo
    ElseIf Target.Value = "AT" Then
        Target.Interior.ColorIndex = 4   'verde
    ElseIf Target.Value = "JO" Then
        Target.Interior.ColorIndex = 6   'amarillo
    ElseIf Target.Value = "JJ" Then
        Target.Interior.ColorIndex = 39    'violeta
    ElseIf Target.Value = "EN" Then
        Target.Interior.ColorIndex = 7   'rosa
    ElseIf Target.Value = "RE" Then
        Target.Interior.ColorIndex = 12   'marron
End If
End Sub

2 respuestas

Respuesta
3

Un detalle no me queda claro. Tu macro no tiene restricciones de celdas, es decir que así como está se ejecuta en cualquier celda de la hoja.

La pregunta es si el resto de las condiciones solo debiera contemplarse en el rango B19:AR357

Quedo atenta a tus aclaraciones. No valores aún.

Si vas a mantener el resto tal como ahora, es decir que en TODA la hoja se colorea según los valores originales, pero en el rango B19:AR367 además se deben evaluar nuevas letras, el código sería éste, contemplando además la protección de la hoja:

Private Sub Worksheet_Change(ByVal Target As Range)
'si se seleccionaron varias al mismo tiempo no ejecuta (solo se les quita color)
If Target.Count > 1 Then Target.Interior.ColorIndex = xlNone: Exit Sub
'en cualquiera de las filas, si es vacío se quita color y finaliza
If Target = "" Then
    Target.Interior.ColorIndex = xlNone
    Exit Sub
End If
'desproteje hoja
ActiveSheet.Unprotect "JS"
'según el texto va el color - ya controlé al inicio que si dejo vacía le quite color
If Target.Value = "JS" Then
    Target.Interior.ColorIndex = 37   'azul
ElseIf Target.Value = "DP" Then
    Target.Interior.ColorIndex = 3   'Rojo
ElseIf Target.Value = "AT" Then
    Target.Interior.ColorIndex = 4   'verde
ElseIf Target.Value = "JO" Then
    Target.Interior.ColorIndex = 6   'amarillo
ElseIf Target.Value = "JJ" Then
    Target.Interior.ColorIndex = 39    'violeta
ElseIf Target.Value = "EN" Then
    Target.Interior.ColorIndex = 7   'rosa
ElseIf Target.Value = "RE" Then
    Target.Interior.ColorIndex = 12   'marron
End If
If Not Intersect(Target, Range("B19:AR367")) Is Nothing Then
    If Target.Value = "V" Or Target.Value = "L" Or Target.Value = "S" Or Target.Value = "AP" Or Target.Value = "FJ" Or Target.Value = "VP" Then
        If Range("A" & Target.Row) = "JS" Then Target.Interior.ColorIndex = 37
        If Range("A" & Target.Row) = "DP" Then Target.Interior.ColorIndex = 3
        If Range("A" & Target.Row) = "AT" Then Target.Interior.ColorIndex = 4
        If Range("A" & Target.Row) = "JO" Then Target.Interior.ColorIndex = 6
        If Range("A" & Target.Row) = "JJ" Then Target.Interior.ColorIndex = 39
        If Range("A" & Target.Row) = "EN" Then Target.Interior.ColorIndex = 7
        If Range("A" & Target.Row) = "RE" Then Target.Interior.ColorIndex = 12
    End If
End If
'vuelvo a proteger la hoja
ActiveSheet.Protect "JS"
End Sub

Como no se contempló anteriormente rango alguno, lo que sucederá por ej, en B20 (celda del rango especial), sería lo siguiente.

-Si se ingresa AT se pintará de verde

-Si se ingresa V y A20 =JS se pintará de azul

-Si se ingresa V y A20 vacío o un valor <> a los criterios ... no se pintará.

Evalúa y aclara si esto no es lo que necesitas. Si todo es correcto, no olvides valorar esta respuesta.

Sdos

Elsa

Si en B20

Hola y gracias, Elsa.

No se si te he entendido. Sólo voy quiero aplicarlo a ese rango, así que si se puede limitar, mejor.

No obstante, me sale un error cuando quiero borrar una celda.

Si una celda escrita ( y coloreada), la quiero suprimir, debería ponerse otra vez en blanco.

Gracias y un saludo,

Por ahora quítale las líneas de protección y trabaja con la hoja desprotegida para poder probar el alcance del cambio de color.

Entiendo ahora que solo debe colorearse el rango B19:AR367 cuando se ingresan datos como: JS, DP, AT, etc

Y si se ingresan datos como: V, L, ES, etc se debe mirar la col A de la misma fila.

¿Es correcto lo que se observa en la imagen?

Entonces la macro debiera quedar del siguiente modo. Por ahora trabaja con la hoja desprotegida, luego me indicas qué rangos están desbloqueados o no.

Private Sub Worksheet_Change(ByVal Target As Range)
'x Elsamatilde
'solo se controla cambios en el rango solicitado
If Intersect(Target, Range("B19:AR357")) Is Nothing Then Exit Sub
'si se seleccionaron varias al mismo tiempo no ejecuta (solo se les quita color)
If Target.Count > 1 Then
    Target.Interior.ColorIndex = xlNone
    Exit Sub
End If
'en cualquiera de las filas, si es vacío se quita color y finaliza
If Target = "" Then
    Target.Interior.ColorIndex = xlNone
    Exit Sub
End If
'según el texto va el color - ya controlé al inicio que si dejo vacía le quite color
If Target.Value = "JS" Then Target.Interior.ColorIndex = 37   'azul
If Target.Value = "DP" Then Target.Interior.ColorIndex = 3   'Rojo
If Target.Value = "AT" Then Target.Interior.ColorIndex = 4   'verde
If Target.Value = "JO" Then Target.Interior.ColorIndex = 6   'amarillo
If Target.Value = "JJ" Then Target.Interior.ColorIndex = 39    'violeta
If Target.Value = "EN" Then Target.Interior.ColorIndex = 7   'rosa
If Target.Value = "RE" Then Target.Interior.ColorIndex = 12   'marron
'se colorea según valor ingresado y valor de la col A
If Target.Value = "V" Or Target.Value = "L" Or Target.Value = "S" Or Target.Value = "AP" Or Target.Value = "FJ" Or Target.Value = "VP" Then
    If Range("A" & Target.Row) = "JS" Then Target.Interior.ColorIndex = 37
    If Range("A" & Target.Row) = "DP" Then Target.Interior.ColorIndex = 3
    If Range("A" & Target.Row) = "AT" Then Target.Interior.ColorIndex = 4
    If Range("A" & Target.Row) = "JO" Then Target.Interior.ColorIndex = 6
    If Range("A" & Target.Row) = "JJ" Then Target.Interior.ColorIndex = 39
    If Range("A" & Target.Row) = "EN" Then Target.Interior.ColorIndex = 7
    If Range("A" & Target.Row) = "RE" Then Target.Interior.ColorIndex = 12
End If
End Sub

Si esto no es lo que necesitas sube una imagen en colores,

Sdos

Elsa

Ok.

Con la hoja desprotegida, hace exactamente lo que necesito.

¿Se puede quedar protegida la hoja?

Las celdas donde escribo, ya las he obigado a que no se bloqueen.

Muchas gracias.

Si, podés proteger la hoja luego de 'desbloquear' aquellas celdas donde vayas a ingresar datos y colorear.

En ese caso no es necesario agregar instrucciones al código.

Sdos!

¡Gracias, Elsa! 

Recibe un cordial saludo.

Hola.

Sólo una cosa mas.

He probado a "arrastrar" la celda para copiar el contenido en varias celdas, y de esa forma no se colorean.¿Se podría corregir? He probado varias formas y no lo consigo.

Sería como ejecutar la macro de forma manual y que coloree las celdas según el contenido, con los criterios del principio.

Saludos,

No, no es de ese modo como se ejecuta el evento Change de la celda, sino 'tipeando' algo en ella.

Se me ocurre entonces que quizás debieras utilizar Formato condicional en lugar de macros... pero eso ya sería otro tema y merecerá dejarlo en nueva consulta.

Sdos!

Respuesta
2

Te anexo la macro.

Private Sub Worksheet_Change(ByVal Target As Range)
    'si se seleccionaron varias al mismo tiempo no ejecuta (solo se les quita color)
    If Target.Count > 1 Then Target.Interior.ColorIndex = xlNone: Exit Sub
    'en cualquiera de las filas, si es vacío se quita color y finaliza
    If Target = "" Then
        Target.Interior.ColorIndex = xlNone
        Exit Sub
    End If
    'según el texto va el color - ya controlé al inicio que si dejo vacía le quite color
    If Target.Value = "JS" Then
        Target.Interior.ColorIndex = 37   'azul
    ElseIf Target.Value = "DP" Then
        Target.Interior.ColorIndex = 3   'Rojo
    ElseIf Target.Value = "AT" Then
        Target.Interior.ColorIndex = 4   'verde
    ElseIf Target.Value = "JO" Then
        Target.Interior.ColorIndex = 6   'amarillo
    ElseIf Target.Value = "JJ" Then
        Target.Interior.ColorIndex = 39    'violeta
    ElseIf Target.Value = "EN" Then
        Target.Interior.ColorIndex = 7   'rosa
    ElseIf Target.Value = "RE" Then
        Target.Interior.ColorIndex = 12   'marron
    End If
    '
    If Not Intersect(Target, Range("B19:AR367")) Is Nothing Then
        Select Case UCase(Target.Value)
        Case "V", "L", "S", "AP", "FJ", "VP"
            Select Case Cells(Target.Row, "A")
            Case "JS": Target.Interior.ColorIndex = 37   'azul
            Case "DP": Target.Interior.ColorIndex = 3    'rojo
            Case "AT": Target.Interior.ColorIndex = 4    'verde
            Case "JO": Target.Interior.ColorIndex = 6    'amarillo
            Case "JJ": Target.Interior.ColorIndex = 39   'violeta
            Case "EN": Target.Interior.ColorIndex = 7    'rosa
            Case "RE": Target.Interior.ColorIndex = 12   'marron
            End Select
        End Select
    End If
End Sub

Saludos.Dante Amor

Recuerda valorar la respuesta.

Gracias, Dante.

Has coincidido con Elsa en la respuesta. Funciona bien excepto cuando borras una celda, que sale un error. Debería de dejar la celda vacía y en blanco.

Gracias y un saludo,

Prueba nuevamente.

Private Sub Worksheet_Change(ByVal Target As Range)
'Act.Por.Dante Amor
    ActiveSheet.Unprotect "JS"
    'si se seleccionaron varias al mismo tiempo no ejecuta (solo se les quita color)
    If Target.Count > 1 Then Target.Interior.ColorIndex = xlNone: Exit Sub
    'en cualquiera de las filas, si es vacío se quita color y finaliza
    If Target = "" Then Target.Interior.ColorIndex = xlNone
    'según el texto va el color - ya controlé al inicio que si dejo vacía le quite color
    Select Case Target.Value
        Case "JS": Target.Interior.ColorIndex = 37 'azul
        Case "DP": Target.Interior.ColorIndex = 3  'Rojo
        Case "AT": Target.Interior.ColorIndex = 4  'verde
        Case "JO": Target.Interior.ColorIndex = 6  'amarillo
        Case "JJ": Target.Interior.ColorIndex = 39 'violeta
        Case "EN": Target.Interior.ColorIndex = 7  'rosa
        Case "RE": Target.Interior.ColorIndex = 12 'marron
    End Select
    '
    If Not Intersect(Target, Range("B19:AR367")) Is Nothing Then
        Select Case UCase(Target.Value)
        Case "V", "L", "S", "AP", "FJ", "VP"
            Select Case Cells(Target.Row, "A")
            Case "JS": Target.Interior.ColorIndex = 37   'azul
            Case "DP": Target.Interior.ColorIndex = 3    'rojo
            Case "AT": Target.Interior.ColorIndex = 4    'verde
            Case "JO": Target.Interior.ColorIndex = 6    'amarillo
            Case "JJ": Target.Interior.ColorIndex = 39   'violeta
            Case "EN": Target.Interior.ColorIndex = 7    'rosa
            Case "RE": Target.Interior.ColorIndex = 12   'marron
            End Select
        End Select
    End If
    ActiveSheet.Protect "JS"
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Tengo este código en Visual basic para Excel, y no me funciona.

El código es el siguiente: Private Sub Worksheet_Change(ByVal Target As Range) 'Por.jom uf = Range("H" & Rows.Count).End(xlUp).Row If Target.Count > 1 Then Exit Sub If Not IsNumeric(Target) Then Exit Sub If Target = "" Then Target.Interior.ColorIndex...
1 respuesta

Auto ejecutar una macro

Quiero que se autoejecute una macro que tengo en un libro pero no se como ya que soy muy novato, el nombre de la macro es Private Sub Worksheet_Change(ByVal Target As Range).
1 respuesta

Cambiar indistintamente el valor que comparten dos celdas ( II)

Lamentablemente la solución que me dió Elsa no me vale del todo: Private Sub Worksheet_Change(ByVal Target As Range) 'x Elsamatilde If Not Intersect(Target, Range("A1:A10")) Is Nothing Then Range("B" & Target.Row) = Target.Value ElseIf Not...
1 respuesta

Celda Excel Intermitente

Busco vuestra ayuda de expertos ante el siguiente problema, necesito una macro, que cada vez que en la celda "A10" del libro "bloques" la cantidad sea distinta a 75 el color de la celda o mejor dicho el fondo de la celda parpadee entre dos colores de...
1 respuesta

Ejecutar "x" macro cuando cambia valor"x" columna

Soy nuevo aquí, y tengo un dilema. Todas las respuestas que he mirado hablan de ejecutar una macro cuando se cambia una celda y no me sirven. Pues bien, tengo 5 macros en una hoja, cada una asociada a una columna con sus respectivas celdas. Las...
1 respuesta

Macro que cambie fuente de letra en fila

Quisiera saber si me podrían apoyar; tengo una macro: Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 17 Then On Error GoTo fin Select Case Target.Value Case "EN CLIENTE CARGANDO" Range("A" & LTrim(Str(Target.Row)) & ":Q" &...
1 respuesta

Dividir procedimiento demasiado largo

No se si la otra pregunta se envío correctamente, te pido por favor si me puedes escribir como dividir este procedimiento en dos o más partes, porque el original excede los 64 KB y no he podido hacerlo usando el Call, supongamos el nombre para llamar...
1 respuesta

Macros con formatos condicionales

El cual detallo a continuación. Tengo una base de datos de 1000 filas y 25 27 columnas. El punto es que he creado un formato condicional según el cual, si en la celda B8 aparece la letra "i" el rango C8:AA8 se colorea, lo cual se aplica a 2...
1 respuesta