Inicio > Software > Contabilizar las celdas de colores en Excel

Contabilizar las celdas de colores en Excel

Después de tanto indagar en Microsoft Excel, me dí cuenta que no había ninguna función que me permitiese contar los colores de cada celda.

Así que lo que hice es, hacer lo que solemos hacer siempre, introducirme en el fabuloso mundo de Google y de los foros. La solución que encontré fue, la de crear una nueva Macro.
Los pasos a seguir son los siguientes:

1. Abrimos el Excel, “sino lo vas a tener difícil”
2. Seleccionamos en el menú de Herramientas “Macros”
3. Dentro de Macros, seleccionamos la opción Macros…
4. Se nos abrirá un recuadro en el que nos pide el nombre de la Nueva Macro.
5. Una vez introducido el nombre, se nos activa la opción “Crear”,pues bien, le damos a crear.
6. Nos aparecerá un cuadro M.V.B. en el que tenemos que pegar el siguiente código:

Function ContarColorFondo(rngCeldaColor As Range, rngRangoAcontar As Range) As Double
Application.Volatile
If rngCeldaColor.Cells.Count 1 Then Exit Function

Dim rngCelda As Range
For Each rngCelda In rngRangoAcontar
If rngCelda.Interior.ColorIndex = rngCeldaColor.Interior.ColorIndex Then ContarColorFondo = ContarColorFondo + 1
Next rngCelda
Set rngCelda = Nothing
End Function

Function NumeroColor(rngR As Range) As Long
NumeroColor = rngR.Cells(1, 1).Interior.ColorIndex
End Function

7. Una vez hecho esto le damos a Guardar.

Con estos pasos ya podemos buscarla “con el nombre que le hemos puesto a la Macro”, como función y aplicarla como cualquier otra función. Suerte

Comentarios antiguo blog

About these ads
Categorías:Software Etiquetas:
  1. martin
    enero 18, 2010 en 4:18 pm | #1

    la verdad esta exelente aunque no puedo hacer que me tire valor que en realidad es y al usarla una segunda vez, da error en el if

    • enero 21, 2010 en 1:16 am | #2

      Tienes toda la razón, voy a intentar averiguar que pasa

  2. Ricardo León
    julio 13, 2012 en 7:27 pm | #4

    Buenas queridos amigos, :decabeza:

    Un amigo y yo llevamos días intentando finalizar una macro para una aplicación de turnos de nuestro trabajo. Hemos desplegado los días del año en la columna B y los nombres en la fila 6. El caso es que la siguiente macro nos permite variar el color según el indicativo de la celda inferior derecha (rango de cada casilla de turnos 2:3)

    Pues bien, hemos conseguido que al indicar en esta celda inferior derecha, “BAJA”, “VAC”, “L”, etc… copie el valor de la celda que se encuentra a la izquierda de esta, en un rango de celdas que se encuentra mucho más abajo (3000 filas más abajo) para después sumarlos o tratarlos según nos interese. [B]Sin embargo nuestra macro no consigue leer el dato si es copiado y pegado!!! SOS!!![/B] Nos vamos a volver locos!!! Hemos intentado de todo…. y cuando digo de todo… es de todo.

    [QUOTE]Private Sub Worksheet_Change(ByVal Target As Range)

    If (Target.Column / 2) = Int((Target.Column / 2)) And Target.Row <= 2529 Then
    Select Case Target.Value
    Case Is = "BAJA", "baja"
    Cells(LTrim(Str(Target.Row)), Target.Column).Interior.ColorIndex = 27
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column).Interior.ColorIndex = 27
    Cells(LTrim(Str(Target.Row)), Target.Column – 1).Interior.ColorIndex = 27
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column – 1).Interior.ColorIndex = 27
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column).Interior.ColorIndex = 27
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column – 1).Interior.ColorIndex = 27
    'OLI: ESTE CASE HACE REFERENCIA A LAS HORAS INDICADAS EN EL CUADRO
    Case Is = "BAJAH", "bajah"
    Cells(LTrim(Str(Target.Row)), Target.Column).Interior.ColorIndex = 27
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column).Interior.ColorIndex = 27
    Cells(LTrim(Str(Target.Row)), Target.Column – 1).Interior.ColorIndex = 27
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column – 1).Interior.ColorIndex = 27
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column).Interior.ColorIndex = 27
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column – 1).Interior.ColorIndex = 27
    'OLI: ESTE CASE HACE REFERENCIA A LAS HORAS INDICADAS EN EL CUADRO
    Case Is = "HSH", "hsh"
    Cells(LTrim(Str(Target.Row)), Target.Column).Interior.ColorIndex = 45
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column).Interior.ColorIndex = 45
    Cells(LTrim(Str(Target.Row)), Target.Column – 1).Interior.ColorIndex = 45
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column – 1).Interior.ColorIndex = 45
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column).Interior.ColorIndex = 45
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column – 1).Interior.ColorIndex = 45
    'OLI: ESTE CASE HACE REFERENCIA A LAS HORAS INDICADAS EN EL CUADRO
    Case Is = "CUH", "cuh"
    Cells(LTrim(Str(Target.Row)), Target.Column).Interior.ColorIndex = 37
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column).Interior.ColorIndex = 37
    Cells(LTrim(Str(Target.Row)), Target.Column – 1).Interior.ColorIndex = 37
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column – 1).Interior.ColorIndex = 37
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column).Interior.ColorIndex = 37
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column – 1).Interior.ColorIndex = 37
    Case Is = "VAC", "vac"
    Cells(LTrim(Str(Target.Row)), Target.Column).Interior.ColorIndex = 35
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column).Interior.ColorIndex = 35
    Cells(LTrim(Str(Target.Row)), Target.Column – 1).Interior.ColorIndex = 35
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column – 1).Interior.ColorIndex = 35
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column).Interior.ColorIndex = 35
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column – 1).Interior.ColorIndex = 35
    Case Is = "EXC", "exc"
    Cells(LTrim(Str(Target.Row)), Target.Column).Interior.ColorIndex = 16
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column).Interior.ColorIndex = 16
    Cells(LTrim(Str(Target.Row)), Target.Column – 1).Interior.ColorIndex = 16
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column – 1).Interior.ColorIndex = 16
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column).Interior.ColorIndex = 16
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column – 1).Interior.ColorIndex = 16
    Case Is = "NO", "no"
    Cells(LTrim(Str(Target.Row)), Target.Column).Interior.ColorIndex = 15
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column).Interior.ColorIndex = 15
    Cells(LTrim(Str(Target.Row)), Target.Column – 1).Interior.ColorIndex = 15
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column – 1).Interior.ColorIndex = 15
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column).Interior.ColorIndex = 15
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column – 1).Interior.ColorIndex = 15
    Case Is = "LR", "lr"
    Cells(LTrim(Str(Target.Row)), Target.Column).Interior.ColorIndex = 38
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column).Interior.ColorIndex = 38
    Cells(LTrim(Str(Target.Row)), Target.Column – 1).Interior.ColorIndex = 38
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column – 1).Interior.ColorIndex = 38
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column).Interior.ColorIndex = 38
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column – 1).Interior.ColorIndex = 38
    Case Is = "LNR", "lnr"
    Cells(LTrim(Str(Target.Row)), Target.Column).Interior.ColorIndex = 46
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column).Interior.ColorIndex = 46
    Cells(LTrim(Str(Target.Row)), Target.Column – 1).Interior.ColorIndex = 46
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column – 1).Interior.ColorIndex = 46
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column).Interior.ColorIndex = 46
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column – 1).Interior.ColorIndex = 46
    Case Is = "ABS", "abs"
    Cells(LTrim(Str(Target.Row)), Target.Column).Interior.ColorIndex = 3
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column).Interior.ColorIndex = 3
    Cells(LTrim(Str(Target.Row)), Target.Column – 1).Interior.ColorIndex = 3
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column – 1).Interior.ColorIndex = 3
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column).Interior.ColorIndex = 3
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column – 1).Interior.ColorIndex = 3
    Case Is = "SES", "ses"
    Cells(LTrim(Str(Target.Row)), Target.Column).Interior.ColorIndex = 9
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column).Interior.ColorIndex = 9
    Cells(LTrim(Str(Target.Row)), Target.Column – 1).Interior.ColorIndex = 9
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column – 1).Interior.ColorIndex = 9
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column).Interior.ColorIndex = 9
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column – 1).Interior.ColorIndex = 9
    Case Is = "L", "l", " "
    Cells(LTrim(Str(Target.Row)), Target.Column).Interior.ColorIndex = 2
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column).Interior.ColorIndex = 2
    Cells(LTrim(Str(Target.Row)), Target.Column – 1).Interior.ColorIndex = 2
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column – 1).Interior.ColorIndex = 2
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column).Interior.ColorIndex = 2
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column – 1).Interior.ColorIndex = 2
    Case Is = "JT", "OFI", "SUP", "GES", "RRHH", "jt", "ofi", "sup", "ges", "rrhh"
    Cells(LTrim(Str(Target.Row)), Target.Column).Interior.ColorIndex = 39
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column).Interior.ColorIndex = 39
    Cells(LTrim(Str(Target.Row)), Target.Column – 1).Interior.ColorIndex = 39
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column – 1).Interior.ColorIndex = 39
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column).Interior.ColorIndex = 39
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column – 1).Interior.ColorIndex = 39
    Case Is = "HS", "hs"
    Cells(LTrim(Str(Target.Row)), Target.Column).Interior.ColorIndex = 45
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column).Interior.ColorIndex = 45
    Cells(LTrim(Str(Target.Row)), Target.Column – 1).Interior.ColorIndex = 45
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column – 1).Interior.ColorIndex = 45
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column).Interior.ColorIndex = 45
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column – 1).Interior.ColorIndex = 45
    Case Is = "CU", "cu"
    Cells(LTrim(Str(Target.Row)), Target.Column).Interior.ColorIndex = 37
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column).Interior.ColorIndex = 37
    Cells(LTrim(Str(Target.Row)), Target.Column – 1).Interior.ColorIndex = 37
    Cells(LTrim(Str(Target.Row)) – 1, Target.Column – 1).Interior.ColorIndex = 37
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column).Interior.ColorIndex = 37
    Cells(LTrim(Str(Target.Row)) – 2, Target.Column – 1).Interior.ColorIndex = 37
    Case Else
    End Select
    End If
    End Sub[/QUOTE]

    Saludos cordiales,
    Ricardo

  3. diciembre 7, 2012 en 12:02 pm | #5

    Buenas, he probado la macro, pero no entiendo la linea:

    <>, de hecho mi excel tampoco :D ya que con esta linea no funciona correctamente.

    Si lo dejamos asi: funciona sin problemas:

    Function CONTARCOLORFONDO(rngCeldaColor As Range, rngRangoAcontar As Range) As Double
    Application.Volatile

    Dim rngCelda As Range
    For Each rngCelda In rngRangoAcontar
    If rngCelda.Interior.ColorIndex = rngCeldaColor.Interior.ColorIndex Then CONTARCOLORFONDO = CONTARCOLORFONDO + 1
    Next rngCelda
    Set rngCelda = Nothing
    End Function

    Function NumeroColor(rngR As Range) As Long
    NumeroColor = rngR.Cells(1, 1).Interior.ColorIndex
    End Function

  4. diciembre 7, 2012 en 12:04 pm | #6

    juanito82an :Buenas, he probado la macro, pero no entiendo la linea:
    <>, de hecho mi excel tampoco ya que con esta linea no funciona correctamente.
    Si lo dejamos asi: funciona sin problemas:
    Function CONTARCOLORFONDO(rngCeldaColor As Range, rngRangoAcontar As Range) As DoubleApplication.Volatile
    Dim rngCelda As RangeFor Each rngCelda In rngRangoAcontarIf rngCelda.Interior.ColorIndex = rngCeldaColor.Interior.ColorIndex Then CONTARCOLORFONDO = CONTARCOLORFONDO + 1Next rngCeldaSet rngCelda = NothingEnd Function
    Function NumeroColor(rngR As Range) As LongNumeroColor = rngR.Cells(1, 1).Interior.ColorIndexEnd Function

    Perdon, la linea es: If rngCeldaColor.Cells.Count 1 Then Exit Function

  5. mayo 8, 2013 en 6:21 am | #7

    I wanted to thank you for this fantastic read!! I certainly enjoyed every bit of it.
    I have you book marked to look at new stuff you post…

  6. Jorge Banderas
    mayo 23, 2013 en 6:36 pm | #8

    Se puede mejorar la funcion para que se actualice el conteo en tiempo real? la funcion trabaja pero si se agregan colores en cierto rango, el valor no se actualiza.

  7. Macarena
    junio 20, 2013 en 1:44 am | #9

    Jorge Banderas :
    Se puede mejorar la funcion para que se actualice el conteo en tiempo real? la funcion trabaja pero si se agregan colores en cierto rango, el valor no se actualiza.

    Si es que encuentras la forma de actualizarlo porfavor dime, estoy en las mismas

  1. No trackbacks yet.

Deja un comentario

Introduce tus datos o haz clic en un icono para iniciar sesión:

Logo de WordPress.com

Estás comentando usando tu cuenta de WordPress.com. Cerrar sesión / Cambiar )

Imagen de Twitter

Estás comentando usando tu cuenta de Twitter. Cerrar sesión / Cambiar )

Foto de Facebook

Estás comentando usando tu cuenta de Facebook. Cerrar sesión / Cambiar )

Google+ photo

Estás comentando usando tu cuenta de Google+. Cerrar sesión / Cambiar )

Conectando a %s

Seguir

Recibe cada nueva publicación en tu buzón de correo electrónico.

Únete a otros 74 seguidores

%d personas les gusta esto: