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

Respuesta
3

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 Sub

Lo 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

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas