Como sumar celdas de un mismo color




En muchas ocasiones cuando se programa una macro se necesita realizar acciones sobre celdas que contiene un mismo color, en este ejemplo se expone como sumar celdas que contienen el mismo color de relleno.

En esta web encontrarás otros post que explican como como dar formato tamaño, tipo, negrita, cursiva, subrayado y color a la fuente de Excel, establecer color y bordes de celdas, determinar color de celdas, ancho alto ocultar mostrar filas y columnas.


Si necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.






Domina Excel Hoy
En el ejemplo presentado hay dos colores de celdas rojo y celeste, lo primero que se determina es el color de la celda, mejor dicho el número del color de la celdas en este caso rojo, le corresponde el número 255 y celeste el número 15773696.

Para sumar se realiza un bucle hasta la última celda con datos, se va recorriendo las celdas y si son de color rojo hace una suma, si son de color celeste hace otra suma, al final del ejemplo presenta el total de las celdas de color rojo y el total de las celdas de color celeste, aconsejo descargar el ejemplo desde el link del final para poder observar en detalle el funcionamiento.

Aporta a los fines de seguir manteniendo el sitio, suscribe al blog para recibir en tu correo todas las actualizaciones, dispones también de un canal de You Tube donde encontrarás explicaciones de macros con mayor detalle.

Código que se inserta en un módulo



Sub DarFormato()
Application.ScreenUpdating = False
Dim conta1 As Integer, conta2 As Integer
c1 = Range("C2").Interior.Color
c2 = Range("C3").Interior.Color
pf = 2
uf = Range("C" & Rows.Count).End(xlUp).Row
conta1 = 0
conta2 = 0
Do
If Cells(pf, "C").Interior.Color = 255 Then conta1 = conta1 + Cells(pf, "D").Value
If Cells(pf, "C").Interior.Color = 15773696 Then conta2 = conta2 + Cells(pf, "D").Value
pf = pf + 1
Loop While pf <= uf
Range("D16") = conta1
Range("D17") = conta2

Application.ScreenUpdating = True
End Sub
Sub borraformato()
Application.ScreenUpdating = False
Range("D16:D17").Clear
Application.ScreenUpdating = True
End Sub



Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends