MACRO Contar si las celdas están con color
En un rango de celdas que se tiene como en la imagen, se encuentran 3 colores los cuales tienen un numero en cada casillero, lo que deseo es sumar los 3 tipos de colores en cada fila.
Verde = Columna C (color.index 4)
Rojo = Columna D (color.index 3)
Azul = Columna E (color.index 5)
Gracias por tu apoyo
1 Respuesta
Te anexo la macro
Sub Contar_Colores()
'Por.Dante Amor
u = Range("A" & Rows.Count).End(xlUp).Row
If u < 5 Then u = 5
Range("C5:E" & u).ClearContents
For i = 5 To u
For j = Columns("F").Column To Cells(4, Columns.Count).End(xlToLeft).Column
Select Case Cells(i, j).Interior.ColorIndex
Case 4: Cells(i, "C") = Cells(i, "C") + 1 'verde
Case 3: Cells(i, "D") = Cells(i, "D") + 1 'rojo
Case 5: Cells(i, "E") = Cells(i, "E") + 1 'azul
End Select
Next
Next
MsgBox "fin"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Gracias por tu apoyo, pero tengo una complicación solo está contando los casilleros que tienen cada color, lo que yo requiero es la suma de los valores que están dentro de cada casillero con un decimal de exactitud, apoyame en esto por favor.
No es una complicación, tu petición es esta:
"Lo que deseo es sumar los 3 tipos de colores en cada fila"
Además si hubieras puesto un ejemplo de lo que esperabas como resultado, eso ayudaría a comprender qué esperas como resultado.
Tampoco entiendo a qué te refieres con "un decimal de exactitud", en tu imagen solamente veo 1 y 0, pero puede ser 0.01, no lo sé, si pones ejemplos reales de lo que tienes y de lo que esperas como resultado.
Prueba con la siguiente macro
Sub Contar_Colores()
'Por.Dante Amor
u = Range("A" & Rows.Count).End(xlUp).Row
If u < 5 Then u = 5
Range("C5:E" & u).ClearContents
For i = 5 To u
For j = Columns("F").Column To Cells(4, Columns.Count).End(xlToLeft).Column
Select Case Cells(i, j).Interior.ColorIndex
Case 4: Cells(i, "C") = Cells(i, "C") + cells(i, j) 'verde
Case 3: Cells(i, "D") = Cells(i, "D") + cells(i, j) 'rojo
Case 5: Cells(i, "E") = Cells(i, "E") + cells(i, j) 'azul
End Select
Next
Next
MsgBox "fin"
End SubLo del decimal lo puedes ajustar en el formato de las columnas C a D para que se vea un decimal
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
