如何统计条件格式中的设置背景颜色的单元格数量？

Question

我做了个表，如下图：表中红色单元格及白色字体是使用条件格式自动显示出来的，我现在需要在每一行中最后这个单元格中统计这一行里面红色单元格的数量。
写详细步骤。谢谢！~在线等！

Answer 1

先试一试这个公式： =COUNT(MATCH(ARRAY1,ARRAY2,0))

如果不行的话看一下条件格式

如果不行再用VB：

Function CountColor(rng As Range, lColor As Long) As Long

    Dim cel As Range

    CountColor = 0

    For Each cel In rng

        If GetFontColor(cel) = lColor Then

            CountColor = CountColor + 1

        End If

    Next

End Function

Sub checkFormatCondition()

    Dim cel As Range

    Dim lCount As Long

    lCount = 0

    ThisWorkbook.Activate

    Worksheets(1).Select

    For Each cel In ThisWorkbook.Worksheets(1).Range("B3:B50")

        If GetFontColor(cel) = vbRed Then

            lCount = lCount + 1

        End If

    Next

    MsgBox lCount

End Sub

Function GetFontColor(rng As Range) As Long

    Dim cel As Range

    Dim tmp As Variant

    Dim i As Integer

    Dim fmlNorm As String, fmlR1C1 As String, fmlA1 As String

    Dim bMatch As Boolean

    

    Set cel = rng.Cells(1, 1)

    GetFontColor = cel.Font.Color

    

    If cel.FormatConditions.Count > 0 Then

        With cel.FormatConditions

            For i = 1 To .Count

                fmlNorm = .Item(i).Formula1

                If Left(fmlNorm, 1) = "=" Then

                    fmlR1C1 = Application.ConvertFormula(fmlNorm, xlA1, xlR1C1, , ActiveCell)

                    fmlA1 = Application.ConvertFormula(fmlR1C1, xlR1C1, xlA1, xlAbsolute, cel)

                    bMatch = Application.Evaluate(fmlA1)

                Else

                    Select Case .Item(i).Operator

                        Case xlEqual

                            fmlNorm = cel & "=" & .Item(i).Formula1

                        Case xlNotEqual

                            fmlNorm = cel & "<>" & .Item(i).Formula1

                        Case xlBetween

                            fmlNorm = "AND(" & .Item(i).Formula1 & "<=" & cel & "," & cel & "<=" & .Item(i).Formula2 & ")"

                        Case xlNotBetween

                            fmlNorm = "OR(" & .Item(i).Formula1 & ">" & cel & "," & cel & ">" & .Item(i).Formula2 & ")"

                        Case xlLess

                            fmlNorm = cel & "<" & .Item(i).Formula1

                        Case xlLessEqual

                            fmlNorm = cel & "<=" & .Item(i).Formula1

                        Case xlGreater

                            fmlNorm = cel & ">" & .Item(i).Formula1

                        Case xlGreaterEqual

                            fmlNorm = cel & ">=" & .Item(i).Formula1

                    End Select

                    bMatch = Application.Evaluate(fmlNorm)

                End If

                If bMatch Then

                    On Error Resume Next

                    tmp = .Item(i).Font.Color

                    If Err.Number = 0 Then GetFontColor = tmp

                    Err.Clear

                    On Error GoTo 0

                    Exit For

                End If

            Next i

        End With

    End If

End Function

记着多给分哦

Answer 2

先试试这个公式：=COUNT(MATCH(ARRAY1,ARRAY2,0))
如果不行看看条件格式
如果还不行就用VB：
Function CountColor(rng As Range, lColor As Long) As Long
Dim cel As Range
CountColor = 0
For Each cel In rng
If GetFontColor(cel) = lColor Then
CountColor = CountColor + 1
End If
Next
End Function
Sub checkFormatCondition()
Dim cel As Range
Dim lCount As Long
lCount = 0
ThisWorkbook.Activate
Worksheets(1).Select
For Each cel In ThisWorkbook.Worksheets(1).Range("B3:B50")
If GetFontColor(cel) = vbRed Then
lCount = lCount + 1
End If
Next
MsgBox lCount
End Sub
Function GetFontColor(rng As Range) As Long
Dim cel As Range
Dim tmp As Variant
Dim i As Integer
Dim fmlNorm As String, fmlR1C1 As String, fmlA1 As String
Dim bMatch As Boolean

Set cel = rng.Cells(1, 1)
GetFontColor = cel.Font.Color

If cel.FormatConditions.Count > 0 Then
With cel.FormatConditions
For i = 1 To .Count
fmlNorm = .Item(i).Formula1
If Left(fmlNorm, 1) = "=" Then
fmlR1C1 = Application.ConvertFormula(fmlNorm, xlA1, xlR1C1, , ActiveCell)
fmlA1 = Application.ConvertFormula(fmlR1C1, xlR1C1, xlA1, xlAbsolute, cel)
bMatch = Application.Evaluate(fmlA1)
Else
Select Case .Item(i).Operator
Case xlEqual
fmlNorm = cel & "=" & .Item(i).Formula1
Case xlNotEqual
fmlNorm = cel & "<>" & .Item(i).Formula1
Case xlBetween
fmlNorm = "AND(" & .Item(i).Formula1 & "<=" & cel & "," & cel & "<=" & .Item(i).Formula2 & ")"
Case xlNotBetween
fmlNorm = "OR(" & .Item(i).Formula1 & ">" & cel & "," & cel & ">" & .Item(i).Formula2 & ")"
Case xlLess
fmlNorm = cel & "<" & .Item(i).Formula1
Case xlLessEqual
fmlNorm = cel & "<=" & .Item(i).Formula1
Case xlGreater
fmlNorm = cel & ">" & .Item(i).Formula1
Case xlGreaterEqual
fmlNorm = cel & ">=" & .Item(i).Formula1
End Select
bMatch = Application.Evaluate(fmlNorm)
End If
If bMatch Then
On Error Resume Next
tmp = .Item(i).Font.Color
If Err.Number = 0 Then GetFontColor = tmp
Err.Clear
On Error GoTo 0
Exit For
End If
Next i
End With
End If
End Function
记着多给点分！！ 还有问题到这里：www刀flypc刀info