الدالة المعرفة ColorEA لجمع الخلايا الملونة

=ColorEA($B$1:$C$4,$A$2,2)

=ColorEA($B$1:$C$4,$A$2,2,1)

Function ColorEA(rng As Range, cel As Range, Optional f As Byte = 3, Optional v As Boolean = 1) As Double

'Developer: Eslam Abdullah

'=ColorEA($E$17:$F$20,C21,,0) >> Count

'=ColorEA($E$17:$F$20,C21,,1) >> SUM

'-------------------------------------

    Dim c As Range, r As Range, rf As Range, chk$, result#, indx!, i%, rw%, arr()

    ReDim arr(1 To Application.Max(rng.FormatConditions.Count, 1))

    Application.Volatile

    

    Select Case f

        Case 1

            For Each c In rng

                If c.Interior.Color = cel.Interior.Color Then result = result + IIf(v, Val(c.Value), 1)

            Next c

            

        Case 2, 3

            For i = 1 To rng.FormatConditions.Count

                If rng.FormatConditions(i).Interior.Color = cel.Interior.Color And rng.FormatConditions(i).Type = 2 Then rw = rw + 1: arr(rw) = i

            Next i

            If rw = 0 And f = 2 Then GoTo 1

            

            For Each c In rng

                If c.Interior.Color = cel.Interior.Color And f = 3 Then result = result + IIf(v, Val(c.Value), 1)

                For i = 1 To rw

                        Set rf = Range(rng.FormatConditions(arr(i)).AppliesTo.Address)

                        Set r = Intersect(c, rf)

                        If r Is Nothing Then Exit For

                        

                        indx = (c.Row - rf.Row) * rf.Columns.Count + (c.Column - rf.Column) + 1

                        chk = Application.ConvertFormula(rng.FormatConditions(arr(i)).Formula1, xlA1, xlR1C1)

                        chk = Application.ConvertFormula(chk, xlR1C1, xlA1, , ActiveCell.Resize(rf.Rows.Count, rf.Columns.Count).Cells(indx))

                        If Evaluate(chk) Then result = result + IIf(v, Val(c.Value), 1)

                Next i

            Next c

        Case Else: result = CVErr(xlErrNum)

    End Select

1:  ColorEA = result

End Function