FUNCIONES BÁSICAS SEGÚN EL COLOR DE RELLENO DE LA CELDA APLICADO MANUALMENTE

 Código:

Function IB·PromedioColor(Celda·con·Color·a·Contar As Range, Rango As Range) As Double

    Dim c As Range, S As Double, n As Long

    For Each c In Rango

        If c.Interior.Color = Celda·con·Color·a·Contar.Interior.Color Then

            S = S + c.Value

            n = n + 1

        End If

    Next c

    If n > 0 Then

        IB·PromedioColor = S / n

    Else

        IB·PromedioColor = 0

    End If

End Function

Function IB·RecuentoColor(Celda·con·Color·a·Contar As Range, Rango As Range) As Double

    Dim c As Range, R As Long

    R = 0

    For Each c In Rango

        If c.Interior.Color = Celda·con·Color·a·Contar.Interior.Color Then

            R = R + 1

        End If

    Next c

    IB·RecuentoColor = R

End Function

Function IB·MinColor(Celda·con·Color·a·Contar As Range, Rango As Range) As Double

    Dim c As Range, M As Double, p As Boolean

    M = 0

    p = True

    For Each c In Rango

        If c.Interior.Color = Celda·con·Color·a·Contar.Interior.Color Then

            If p Then

                M = c.Value

                p = False

            Else

                M = Application.WorksheetFunction.Min(M, c.Value)

            End If

        End If

    Next c

    IB·MinColor = M

End Function

Function IB·MaxColor(Celda·con·Color·a·Contar As Range, Rango As Range) As Double

    Dim c As Range, M As Double

    M = 0

    For Each c In Rango

        If c.Interior.Color = Celda·con·Color·a·Contar.Interior.Color Then

            M = Application.WorksheetFunction.Max(M, c.Value)

        End If

    Next c

    IB·MaxColor = M

End Function

Function IB·SumaColor(Celda·con·Color·a·Contar As Range, Rango As Range) As Double

    Dim c As Range, S As Double

    S = 0

    For Each c In Rango

        If c.Interior.Color = Celda·con·Color·a·Contar.Interior.Color Then

            S = S + CDbl(c.Value)

        End If

    Next c

    IB·SumaColor = S

End Function