计算所有 Excel 个具有某种颜色的单元格

Question

I am trying to count all cells with a specific color in Excel. I have written the code below but it does not count the cells highlighted by conditional formatting. Would you have any ideas how to do that? Thanks in advance!

Function CountByColor(rg As Range, RefColorCell As Range) As Long
'Counts cells colored manually, whether hidden by a filter or not. _
    Does not count cells colored by conditional formatting! _
    Install function in a regular module sheet, just like a recorded macro.
Dim cel As Range, rgg As Range
Dim i As Long, RefColor As Long
RefColor = RefColorCell.Interior.Color
Application.Volatile
Set rgg = Intersect(rg, rg.Worksheet.UsedRange)     'In case you passed an entire column
For Each cel In rgg.Cells
    If cel.Interior.Color = RefColor Then i = i + 1
Next
CountByColor = i
End Function

Answer 1

As stated in the comments, this isn't easily accomplished as a CUSTOM function because the property .cel.DisplayFormat.Interior.Color will not return a value as a function, however it will return a value when used as a macro.

To get what you need, you will need the below lengthty set of custom functions that I pulled from Chip Pearson's legendary site . While it is excessive, I tested and it does work when I embedded it into your original function CountByColor .

Sample file here (won't work on Web Version of Excel)

Function CountByColor(rg As Range, RefColorCell As Range) As Long
Dim cel As Range, rgg As Range, i As Long, RefColor As Long

RefColor = RefColorCell.Interior.Color
Application.Volatile
Set rgg = Intersect(rg, rg.Worksheet.UsedRange)
For Each cel In rgg.Cells
    If ColorOfCF(cel) = RefColor Then i = i + 1
Next
CountByColor = i
End Function

Private Function ActiveCondition(Rng As Range) As Long
Dim Ndx As Long, FC As FormatCondition
Dim Temp As Variant, Temp2 As Variant

If Rng.FormatConditions.Count = 0 Then
    ActiveCondition = 0
Else
    For Ndx = 1 To Rng.FormatConditions.Count
        Set FC = Rng.FormatConditions(Ndx)
        Select Case FC.Type
            Case xlCellValue
            Select Case FC.Operator
                Case xlBetween
                    Temp = GetStrippedValue(FC.Formula1)
                    Temp2 = GetStrippedValue(FC.Formula2)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) >= CDbl(FC.Formula1) And _
                           CDbl(Rng.Value) <= CDbl(FC.Formula2) Then
                           ActiveCondition = Ndx
                           Exit Function
                       End If
                   Else
                      If Rng.Value >= Temp And _
                         Rng.Value <= Temp2 Then
                         ActiveCondition = Ndx
                         Exit Function
                      End If
                   End If

                Case xlGreater
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) > CDbl(FC.Formula1) Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    Else
                       If Rng.Value > Temp Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If

                Case xlEqual
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) = CDbl(FC.Formula1) Then
                           ActiveCondition = Ndx
                           Exit Function
                       End If
                    Else
                       If Temp = Rng.Value Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If


                Case xlGreaterEqual
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) >= CDbl(FC.Formula1) Then
                           ActiveCondition = Ndx
                           Exit Function
                       End If
                    Else
                       If Rng.Value >= Temp Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If

              
                Case xlLess
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                        If CDbl(Rng.Value) < CDbl(FC.Formula1) Then
                           ActiveCondition = Ndx
                           Exit Function
                        End If
                    Else
                        If Rng.Value < Temp Then
                           ActiveCondition = Ndx
                           Exit Function
                        End If
                    End If

                Case xlLessEqual
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) <= CDbl(FC.Formula1) Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    Else
                       If Rng.Value <= Temp Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If


                Case xlNotEqual
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) <> CDbl(FC.Formula1) Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    Else
                       If Temp <> Rng.Value Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If

               Case xlNotBetween
                    Temp = GetStrippedValue(FC.Formula1)
                    Temp2 = GetStrippedValue(FC.Formula2)
                    If IsNumeric(Temp) Then
                       If Not (CDbl(Rng.Value) <= CDbl(FC.Formula1)) And _
                          (CDbl(Rng.Value) >= CDbl(FC.Formula2)) Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    Else
                       If Not Rng.Value <= Temp And _
                          Rng.Value >= Temp2 Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If
            
               Case Else
                    Debug.Print "UNKNOWN OPERATOR"
           End Select


        Case xlExpression
            If Application.Evaluate(FC.Formula1) Then
               ActiveCondition = Ndx
               Exit Function
            End If

        Case Else
            Debug.Print "UNKNOWN TYPE"
       End Select

    Next Ndx

End If

ActiveCondition = 0

End Function
 


Private Function ColorOfCF(Rng As Range, Optional OfText As Boolean = False) As Long

Dim AC As Long
AC = ActiveCondition(Rng)
If AC = 0 Then
    If OfText = True Then
       ColorOfCF = Rng.Font.Color
    Else
       ColorOfCF = Rng.Interior.Color
    End If
Else
    If OfText = True Then
       ColorOfCF = Rng.FormatConditions(AC).Font.Color
    Else
       ColorOfCF = Rng.FormatConditions(AC).Interior.Color
    End If
End If

End Function

'''''''''''''''''''''''''''''''''''''''

Private Function GetStrippedValue(CF As String) As String
    Dim Temp As String
    If InStr(1, CF, "=", vbTextCompare) Then
       Temp = Mid(CF, 3, Len(CF) - 3)
       If Left(Temp, 1) = "=" Then
           Temp = Mid(Temp, 2)
       End If
    Else
       Temp = CF
    End If
    GetStrippedValue = Temp
End Function