简体   繁体   中英

Counting Font color in Excel

I am trying to count the number of cells that have a blue font and It won't work. I can count cells with a red font but not blue. This is a custom function I have created using VBA

Function GetFontColorCount(CountRange As Range, CountColor As Range)
    Dim CountColorValue As Integer
    Dim TotalCount As Integer
    CountColorValue = CountColor.Font.Color
    Set rCell = CountRange
    For Each rCell In CountRange
        If rCell.Font.Color = CountColorValue And rCell.Value >= 1 Then
            TotalCount = TotalCount + 1
        End If   
    Next rCell
    GetFontColorCount = TotalCount
End Function

When using the formula It will count red font and black but not blue or any of the other colors that I have tried.

The following procedures assume that the target range is in E6: I18 and that a sample range is used that contains each of the font colors to be counted (the sample range is in B2: B5 )

Sub GetFontColorCount_TEST()
Dim rTrg As Range
Dim rColor As Range
Dim rCll As Range

    Rem Set Ranges
    With ThisWorkbook.Worksheets("DATA")    'Update as required
        Set rTrg = .Range("E6:I18")         'Update as required
        Set rColor = .Range("B2:B5")        'Update as required
    End With

    Rem Get Font Color Count and enter the value besides the sample cell
    For Each rCll In rColor
        rCll.Offset(0, 1).Value2 = Range_ƒFontColor_Count(rTrg, rCll)
    Next

    End Sub

.

Function Range_ƒFontColor_Count(rTrg As Range, rColor As Range)
Dim lColor As Long
Dim lColorCnt As Byte
Dim rCll As Range

    Rem Set sample Font Color
    lColor = rColor.Font.Color

    Rem Count cells with sample Font Color
    For Each rCll In rTrg.Cells
        If rCll.Font.Color = lColor Then lColorCnt = 1 + lColorCnt
    Next

    Range_ƒFontColor_Count = lColorCnt

    End Function

在此处输入图片说明

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM