Cambiar color celda según valor lista desplegable.

Expert@s. Quisiera cambiar el color de una celda según el texto de una lista desplegable.
Lo he intentado con el formato condicional, pero solo me deja usar 3 condiciones y yo necesito por lo menos 11. ¿Hay alguna manera de hacerlo?
Gracias de antemano.
He visto alguna respuesta a este tema, y he visto que habéis mandado un fichero a la persona que lo preguntó.
¿Podríais enviarme ese fichero y/o darme la solución por aquí?

1 Respuesta

Respuesta
1
En Excel 2007 creo que aumentaron bastante el número de condiciones de los formatos condicionales. En Excel 2003 se podría usar algo parecido al siguiente código, que va en el módulo de la hoja (click derecho en la solapa de la hoja -> Ver código:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [Hoja1!A1]) Is Nothing Then Exit Sub 'Cambiar Hoja1!A1 por la hoja y celda reales
    With Target
        If .Cells(1, 1).Validation.Type <> xlValidateList Then Exit Sub 'La celda tiene que tener una validación tipo Lista
        Application.EnableEvents = False
        .Cells(1, 1).Interior.ColorIndex = WorksheetFunction.Match(.Cells(1, 1), Range(.Cells(1, 1).Validation.Formula1), 0) + 2
        Application.EnableEvents = True
    End With
End Sub
El color de fondo que pone el código es el número de fila en la lista de la validación del elemento seleccionado en la celda +2 (para evitar los colores negro y blanco que son el 1 y el 2). Lo malo es que esto puede dar lugar a que el color de la fuente y el color de fondo de la celda no "se lleven" muy bien.
De momento sí que me sirve.
¿Cómo podría hacer que cogiera los colores de esa misma lista?
Gracias por adelantado.
Si la lista con los colores estuviera situada en la columna a la derecha de la lista para la validación, el código sería:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [Hoja1!A1]) Is Nothing Then Exit Sub 'Cambiar Hoja1!A1 por la hoja y celda reales
    Application.EnableEvents = False
    With Target.Cells(1, 1)
        .Interior.ColorIndex = WorksheetFunction. Index(Range(. Validation. Formula1). Resize(, 2), WorksheetFunction. Match(. Value, Range(. Validation.Formula1), 0), 2)
    End With
    Application.EnableEvents = True
End Sub
No consigo crear una lista de validación de dos columnas.
Lo hago por: <Datos> <Validación>, seleccionando "Permitir Lista" e introduciendo el rango, pero sólo me permite un rango de una columna.
Por otro lado, ¿estaré código debe ir para cada una de las fórmulas? ¿Se podría aplicar a un rango? (Sería el resultado de multimplicar una columna por cada día del mes * 17 filas)
Gracias de nuevo
El rango para la lista tiene que ser de una sola columna, es el código el que se encarga de ampliar dicho rango una columna a la derecha (la instrucción Resize).
Las celdas a las que debe aplicarse el código las determina la primera instrucción. Cambiando ! A1 por, por ejemplo, ! A1:A10, se aplicaría a todas las celdas del rango A1:A10.
De todas formas creo que la forma más sencilla de hacer esto es aplicar a cada celda de las que se nutre la lista el formato que se desee que tome la celda con la lista. Es difícil de explicar, aquí he subido un ejemplo: www.jrgc.es/ejemplos/simular_formato_condicional_con_mas_de_3_condiciones.xls
El ejemplo sí que me vale, ya que el anterior código no consigo que me funcione correctamente.
Al pasar este ejemplo, sobre el mío, no me funciona, me imagino que será por la instrucción
Set Target = Target.Cells(1, 1)
¿En lugar de decir el valor 1,1 se le podría indicar 'celda activa'?
Gracias de nuevo
El código está pensado para trabajar tan sólo con la celda A1. Para que haga lo mismo con cualquier celda de la hoja QUE TENGA VALIDACIÓN, el código podría ser:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strFórmula As String 'Se usa sólo para saber si target.cells(1,1) tiene validación
    Set Target = Target.Cells(1, 1)
    'Averiguar si la celda tiene una validación y salir si no la tiene
    On Error GoTo captura
    strFórmula = Target.Validation.Formula1
    On Error Resume Next
    Application.EnableEvents = False
    WorksheetFunction. Index(Range(Target. Validation. Formula1), WorksheetFunction. Match(Target. Value, Range(Target. Validation.Formula1), 0), 1). Copy
    Target.PasteSpecial Paste:=xlPasteFormats
    Application.EnableEvents = True
    Application.CutCopyMode = False
    Exit Sub
captura:
    If Err.Number = 1004 Then Exit Sub Else MsgBox Err.Number & " - " & Err.Description
End Sub
En tu ejemplo, sí que em funciona, pero no soy capaz de hacerlo funcionar en mi código.
No quiero ser pesado alargando demasiado el tema, ya que ya te he molestado bastante.
Cierro el tema, pero con una calificación de excelente, ya que la ayuda ya la reapidez han sido impresionantes.
Gracias

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas