funcion contar color

[cvina]

hola a todos ,

soy el tiene sieme problemas con los colores en Excel😀😀

existe alguna funcion para contar los colores?

tengo una tabla en la que segun la categoria ( diferenciada por color) cconozco la cantidad y categorias de personas en un turno

GRACIAS

EJEMPLO.xlsx

[DiegoPC]

Hola!

La función que quieres no existe en Excel, pero estás en la sección de Macros y programación VBA y aquí creamos todo aquello que no existe (y lo que sí existe, lo re-creamos)

 

EJEMPLO Color.xlsm

[Antoni]

Podríamos acortar un poco la función, aunque no es necesario:

Function Contar_Color(Evaluar As Range, Modelo As Range) As Long

Dim Celda As Range
For Each Celda In Evaluar
    If Celda.Interior.Color = Modelo.Interior.Color Then Contar_Color = Contar_Color + 1
Next

End Function

 

[DiegoPC]

En 9/4/2022 at 12:17 , Antoni dijo:

Podríamos acortar un poco la función, aunque no es necesario:

Un honor compartir hilo con el maestro de maestros! Saludos Antoni! 

Mi función era más larga porque, si bien tiene más código, creo que le toma un poco menos de esfuerzo (en ejecución) a Excel hacer la comparación con una variable que consultar las propiedades del objeto. Como no sabemos la cantidad de celdas a evaluar, puede ser buena idea hacerlo con la variable. ¿Sabes de algún complemento que pruebe y cuantifique qué tan importante sería el ahorro?

 

[Antoni]

Pues tienes razón, tu función es casi el doble de rápida que la mía.

Te dejo la prueba por si quieres repetirla en tu PC.

Function Contar_Color(Evaluar As Range, Modelo As Range) As Long
   Dim ColorModelo As Long
   Dim Celda As Range
   Contar_Color = 0
   ColorModelo = Modelo.Interior.Color
   For Each Celda In Evaluar
       If Celda.Interior.Color = ColorModelo Then Contar_Color = Contar_Color + 1
   Next
End Function
'--
Function Contar_ColorII(Evaluar As Range, Modelo As Range) As Long
   Dim Celda As Range
   For Each Celda In Evaluar
       If Celda.Interior.Color = Modelo.Interior.Color Then Contar_ColorII = Contar_ColorII + 1
   Next
End Function
'--
Sub Prueba()
Dim x As Long
t = Timer
x = Contar_ColorII(Range("A1:A500000"), Range("B1"))
Debug.Print Timer - t
'--
t = Timer
x = Contar_Color(Range("A1:A500000"), Range("B1"))
Debug.Print Timer - t
End Sub

 

[cvina]

muhas gracias,

podrias comentar cada linea de programa? por aprendre lo que etoy haciendo?

[DiegoPC]

Muchas gracias Antoni, a gran escala sí hace una diferencia! 😁