jueves, 3 de diciembre de 2015

VBA: Una suma acumulado con doble criterio según colores de fuente y fondo.

Hace un par de entradas en el blog escribía y explicaba la forma de obtener una suma o conteo acumulado según condiciones de color de relleno o de fuente en un rango de celdas...
Sobre esta cuestión se planteaba una segunda variante, ¿cómo conseguir sumar valores de un rango con una doble condición sobre rangos colocados en cualquier situación aplicando criterios de color sobre Fuente y Fondo-Relleno??

Este sería nuestro planteamiento:

VBA: Una suma acumulado con doble criterio según colores de fuente y fondo.



Para tal fin, insertamos nuestro código dentro de un módulo estándar desde el editor de VB:

Function FxSumaColor(rngSuma As Range, _
    rngFondo As Range, CeldaFondo As Range, _
    rngFuente As Range, CeldaFuente As Range) As Variant

Dim ColorFuente As Long, ColorFondo As Long
Dim Resultado As Double, ColorCeldaFuente As Long, ColorCeldaFondo As Long
'rngSuma: será el rango donde se hallen los valores a sumar
'rngFondo: será el rango de estudio donde comparar el fondo de celda
'CeldaFondo: la celda donde compararemos el color de relleno/fondo
'rngFuente: será el rango de estudio donde comparar la fuente de celda
'CeldaFuente: la celda donde compararemos el color de la fuente

Application.Volatile
'Primero comprobamos que el número de celdas en cada rango
'rngSuma, rngFondo y rngFuente sea el mismo!!
If rngSuma.Cells.Count <> rngFondo.Cells.Count Or _
    rngSuma.Cells.Count <> rngFuente.Cells.Count Or _
    rngFuente.Cells.Count <> rngFondo.Cells.Count Then
        FxSumaColor = "verifica número de celdas en los rangos!!"
        Exit Function
End If

'Identificamos el número de celdas..
Dim num As Long
num = rngSuma.Cells.Count

For i = 1 To num
'Asignamos colores a las variables o condiciones de color de fuente y/o fondo
'Para el color del Fondo
ColorFondo = CeldaFondo.Interior.ColorIndex
ColorCeldaFondo = rngFondo.Item(i).Interior.ColorIndex
'Para el color de la Fuente
ColorFuente = CeldaFuente.Font.ColorIndex
ColorCeldaFuente = rngFuente.Item(i).Font.ColorIndex
    'verificamos la doble coincidencia sobre ambos rangos de estudio...
    If ColorCeldaFondo = ColorFondo And ColorCeldaFuente = ColorFuente Then
        'acumulamos valores sumados cuando coincida con color
        Resultado = WorksheetFunction.Sum(rngSuma.Item(i).Value, Resultado)
    End If
Next i
'devolvemos el valor a la función
FxSumaColor = Resultado
End Function



La base de este planteamiento es el uso de la propiedad .Item asociado al objeto Range, que nos permite identificar cada una de las celdas de los distintos rangos en el orden adecuado para posteriormente evaluar las doble coincidencia de color de fuente y fondo...

Como se observa en la imagen anterior el resultado es correcto...

1 comentario: