Jump to content

funcion contar color


Recommended Posts

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

Link to comment
Share on other sites

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!聽:D

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?

Link to comment
Share on other sites

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

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
  • Create New...

Important Information

Privacy Policy