Đếm chữ tô màu, nhưng không đếm trùng

[AnhThu-1976]

Em chào các anh chị
Em có sưu tầm được công thức đếm màu, nhưng nó đếm luôn những ký tự trùng nhau

Function CountCellsByFontColor(rData As Range, cellRefColor As Range) As Long
    Dim indRefColor As Long
    Dim cellCurrent As Range
    Dim cntRes As Long

    Application.Volatile
    cntRes = 0
    indRefColor = cellRefColor.Cells(1, 1).Font.Color
    For Each cellCurrent In rData
        If indRefColor = cellCurrent.Font.Color Then
            cntRes = cntRes + 1
        End If
    Next cellCurrent

    CountCellsByFontColor = cntRes
End Function

Em muốn nó đếm màu nhưng loại trùng
Em muốn đếm ở cột A của sheet TH, kết quả mong muốn ở ô I1 là 3
Mong anh chị giúp đỡ. Em cảm ơn!

 

[CHAOQUAY]

Em chào các anh chị
Em có sưu tầm được công thức đếm màu, nhưng nó đếm luôn những ký tự trùng nhau

Function CountCellsByFontColor(rData As Range, cellRefColor As Range) As Long
    Dim indRefColor As Long
    Dim cellCurrent As Range
    Dim cntRes As Long

    Application.Volatile
    cntRes = 0
    indRefColor = cellRefColor.Cells(1, 1).Font.Color
    For Each cellCurrent In rData
        If indRefColor = cellCurrent.Font.Color Then
            cntRes = cntRes + 1
        End If
    Next cellCurrent

    CountCellsByFontColor = cntRes
End Function

Em muốn nó đếm màu nhưng loại trùng
Em muốn đếm ở cột A của sheet TH, kết quả mong muốn ở ô I1 là 3
Mong anh chị giúp đỡ. Em cảm ơn!

Test code dưới xem sao

Function CountCellsByFontColor(rData As Range, cellRefColor As Range) As Long
    Dim indRefColor As Long
    Dim cellCurrent As Range
    Dim cntRes As Long
    
    Dim sDic As String '<--

    Application.Volatile
    cntRes = 0
    indRefColor = cellRefColor.Cells(1, 1).Font.Color
    For Each cellCurrent In rData
        If indRefColor = cellCurrent.Font.Color Then
            If InStr(sDic, "#" & cellCurrent.Value & "#") = 0 Then
                sDic = "#" & cellCurrent.Value & "#" & sDic
                cntRes = cntRes + 1
            End If
        End If
    Next cellCurrent

    CountCellsByFontColor = cntRes
End Function