Contar Celdas según Color Interior

Hace muy poco que me he iniciado en VBA EXCEL y necesito contar celdas según su color interior, hasta hora tengo esta macro pero solamente funciona si todas sus celdas están coloreadas y necesito que cuente celdas con o sin datos pero que esten coloreadas :

With Range("A1:Z500")
 Set F = .Find("MAC*", LookIn:=xlValues)
 Set G = .Find("NIU*", LookIn:=xlValues)

Set M = .Find("MACBOR", LookIn:=xlValues)

If Range(F, G).Interior.ColorIndex = 6 Then Range(M, M).Offset(0, 1) = Application.WorksheetFunction.Count(Range(F, G))

End With

2 Respuestas

Respuesta
1

1. SI el Color lo pongo manualmente en la celda

2. Las celdas que quiero contar son las celdas (con o sin datos) que tengan el color asignado, no hay más condiciones.

3. Adjunto imagen del resultado esperado.

Que tengas un feliz día

Respuesta
2

H o l a y bienvenido a TodoExpertos.

Podrías responder las siguientes dudas y en este orden:

1. ¿El color lo pusiste manualmente en la celda o es un color de formato condicional?

2. Quieres contar las celdas qué tienen el color = 6, pero en tu macro tienes otras instrucciones. ¿Puedes explicar si además de contar el color existen otras condiciones? Explica con palabras exactamente cuáles celdas quieres contar.

3. ¿En dónde quieres poner el resultado del conteo? Para este punto, pon una imagen con datos genéricos, en la imagen deben verse las filas, las columnas y el resultado esperado.

Pon los colores que vas a contar en las celdas D2 a D3 o D4, como se muestra en la siguiente imagen.

Es necesario que en la columna A tengas datos. Si quieres más colores para contar, puedes modificar esta línea en la macro:

Set r = Range("D2:D4")

Y pones los colores que quieres contar en las celdas D2, D3, D4 etc.

La macro:

Sub Contar_Celdas_Segun_Color_Interior()
  Dim r As Range, c As Range, i As Long
  Set r = Range("D2:D4")
  r.Cells.ClearContents
  For Each c In r
    For i = 2 To Range("A" & Rows.Count).End(3).Row
      If Range("B" & i).Interior.Color = c.Interior.Color Then
        c.Value = c.Value + 1
      End If
    Next
  Next
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas