Rellenar color celdas de valor más alto

Quiero que los valores que tengo en una columna me los rellene de color según el valor numérico de las celdas, los tres o cuatro mayores de color rojo, por ejemplo, sin descolocarlas

1 Respuesta

Respuesta
1

Te anexo un vídeo para que pongas el formato condicional

https://www.dropbox.com/s/ksyalpzsdmr5137/Untitled%2017.flv?dl=0 

Se me paso un "pequeño detalle" excel 2003..

¿Y lo que viste en el vídeo es lo que necesitas?

Puedes poner ejemplos de lo que tienes y de lo que esperas de resultado.

En la columna a, tengo valores numéricos, y se colorean solo los de mayor valor...

Ejemplo:

       a            b           c         d

1    9,5

2     3

3    12

4     5

5     8

Lo que necesito es colorear las tres o cuatro celdas de mayor importe, es este caso

Seria la a1, a3 y a8, esto seria para hacer en más de 19 columnas

Disculpa que hasta ahora conteste, no había visto que tenías versión 2003.

Prueba con la siguiente macro

Dim valores As New Collection
Dim filas As New Collection
Sub ordenar()
'Por Dante Amor
    col = "A"
    '
    With Columns(col).Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    '
    For i = 1 To Range(col & Rows.Count).End(xlUp).Row
        Call agregar(Cells(i, col), i)
    Next
    j = 1
    For i = 1 To 3
        Cells(filas(i), "A").Interior.ColorIndex = 3
        j = j + 1
    Next
    Set valores = Nothing
    Set filas = Nothing
End Sub
Sub agregar(valor, fila)
'por.DAM agrega los item únicos y en orden alfabético
    For i = 1 To valores.Count
        If valores(i) < valor Then
            valores.Add valor, Before:=i
            filas.Add fila, Before:=i
            Exit Sub
        End If
    Next
    valores.Add valor 'Es mayor lo agrega al final
    filas.Add fila
End Sub

Sigue las Instrucciones para un botón y ejecutar la macro

  1. Abre tu libro de Excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. En el menú elige Insertar / Módulo
  4. En el panel del lado derecho copia la macro
  5. Ahora para crear un botón, puedes hacer lo siguiente:
  6. Inserta una imagen en tu libro, elige del menú Insertar / Imagen / Autoformas
  7. Elige una imagen y con el Mouse, dentro de tu hoja, presiona click y arrastra el Mouse para hacer grande la imagen.
  8. Una vez que insertaste la imagen en tu hoja, dale click derecho dentro de la imagen y selecciona: Tamaño y Propiedades. En la ventana que se abre selecciona la pestaña: Propiedades. Desmarca la opción “Imprimir Objeto”. Presiona “Cerrar”
  9. Vuelve a presionar click derecho dentro de la imagen y ahora selecciona: Asignar macro. Selecciona: ordenar
  10. Aceptar.
  11. Para ejecutarla dale click a la imagen.

Me da un error al ejecutar la macro..

Error 438

Después de depurar..

Me sombrea en amarillo la línea

. TintAndShade =0

¿Qué hago?

Supongo que es por tu versión de excel, prueba con esta macro

Dim valores As New Collection
Dim filas As New Collection
Sub ordenar()
'Por Dante Amor
    col = "A"
    '
    Columns(col).Interior.ColorIndex = xlNone    '
    For i = 1 To Range(col & Rows.Count).End(xlUp).Row
        Call agregar(Cells(i, col), i)
    Next
    j = 1
    For i = 1 To 3
        Cells(filas(i), "A").Interior.ColorIndex = 3
        j = j + 1
    Next
    Set valores = Nothing
    Set filas = Nothing
End Sub
Sub agregar(valor, fila)
'por.DAM agrega los item únicos y en orden alfabético
    For i = 1 To valores.Count
        If valores(i) < valor Then
            valores.Add valor, Before:=i
            filas.Add fila, Before:=i
            Exit Sub
        End If
    Next
    valores.Add valor 'Es mayor lo agrega al final
    filas.Add fila
End Sub

Prueba y me comentas

Ahora si funciona... eso es lo que necesitaba. .. Solo que el ejemplo era de una columna.. y la realidad son más columnas... ¿cómo podría ejecutar la macro sobre más columnas?

¿Para qué sea en automático dime de cuál columna a cuál columna?

¿O es desde la columna "A" y hasta la última columna que tenga datos?

Seria desde la b hasta z...

Pero aun podrían ser más..

Pero lo drjamos con esas

Te anexo la macro, cambia la letra "Z" por la columna que necesistes

Dim valores As New Collection
Dim filas As New Collection
Sub ordenar()
'Por Dante Amor
    '
    uc = Columns("Z").Column
    For col = 2 To uc
        '
        Columns(col).Interior.ColorIndex = xlNone
        '
        For i = 1 To Cells(Rows.Count, col).End(xlUp).Row
            Call agregar(Cells(i, col), i)
        Next
        j = 1
        For i = 1 To 3
            Cells(filas(i), col).Interior.ColorIndex = 3
            j = j + 1
        Next
        Set valores = Nothing
        Set filas = Nothing
    Next
End Sub
Sub agregar(valor, fila)
'por.Dante Amor
    For i = 1 To valores.Count
        If valores(i) < valor Then
            valores.Add valor, Before:=i
            filas.Add fila, Before:=i
            Exit Sub
        End If
    Next
    valores.Add valor 'Es mayor lo agrega al final
    filas.Add fila
End Sub

Lo siento me da un error al ejecutar la macro..

Me sombrea esta línea de la macro;

Cells (filas (i)),col).interior.colorIndex=3

Un saludo

No tienes que disculparte, no es problema tuyo, así son las máquinas, jaja.

¿Qué versión de excel tienes?

¿Tienes datos en todas las columnas?

Mejor envíame tu archivo para revisarlo.

Te lo acabo de enviar..

Saludos 

Esta es la macro, lo que pasa es que tienes columnas en blanco y tienes datos con error: #N/A, pero ya le hice los ajustes a la macro

Dim valores As New Collection
Dim filas As New Collection
Sub ordenar()
'Por Dante Amor
    '
    uc = Cells(4, Columns.Count).End(xlToLeft).Column
    uf = Cells(Rows.Count, "A").End(xlUp).Row
    Range(Cells(4, "A"), Cells(uf - 1, uc)).Interior.ColorIndex = xlNone
    For col = 1 To uc
        '
        If Application.CountA(Range(Cells(4, col), Cells(uf - 1, col))) > 0 Then
            For i = 4 To uf - 1
                If Not IsError(Cells(i, col)) Then
                    Call agregar(Cells(i, col), i)
                End If
            Next
            '
            For i = 1 To filas.Count
                If i = 4 Then Exit For
                Cells(filas(i), col).Interior.ColorIndex = 3
            Next
            Set valores = Nothing
            Set filas = Nothing
        End If
    Next
End Sub
Sub agregar(valor, fila)
'por.Dante Amor
    For i = 1 To valores.Count
        If valores(i) < valor Then
            valores.Add valor, Before:=i
            filas.Add fila, Before:=i
            Exit Sub
        End If
    Next
    valores.Add valor 'Es mayor lo agrega al final
    filas.Add fila
End Sub

¡Gracias!

Muy buena atención y preociupacion por conseguir lo que le pedía...

MUCHAS GRACIAS

Hola.. no se si este es el cauce que debo seguir...

Necesito modificar la macro y no soy capaz, como hacer que no empiece en la columna A.. y empiece en la D.. o en otra..

¿Cómo lo hago?

Cambia el número 1 en la macro por el número de columna que necesitas

For col = 1 To uc

El 1 es para la columna A, el 2 es para la columna B, el 3 para la C, etc.

Estupendo... así lo hice y correcto solo me rellena desde la columna que me interesa, pero lo que hace y no debería de hacer es borrarme el relleno que tengo en las primeras columnas... me explico..

Me rellena a partir de la columna de, por que en las columnas a, b, y c tengo unos datos los cuales yo relleno de unos colores determinados, al ejecutar la macro me borra ese relleno ...

En esta línea de la macro, cambia la "A" por la "D"

Range(Cells(4, "A"), Cells(uf - 1, uc)). Interior.ColorIndex = xlNone

Algo le hice que no me funciona....

Me podrías ayudar..

Ahora me sombrea casillas en blanco...

Cambia esta línea

If Not IsError(Cells(i, col)) Then

Por esta

If Not IsError(Cells(i, col)) And Cells(i, col) <> "" Then

Prueba y me comentas

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas