Đếm chữ tô màu, nhưng không đếm trùng (1 người xem)

[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

 

[bebo021999]

sDic = "#" & cellCurrent.Value & "#" & sDic

Nếu dữ liệu lớn thì không biết cái sDic nối chuỗi này nó dài tới đâu và lúc nào sẽ báo lỗi?
Đã cất công đặt sDic rồi sao không khai báo nó thành Dictionary luôn?

 

[CHAOQUAY]

sDic = "#" & cellCurrent.Value & "#" & sDic

Nếu dữ liệu lớn thì không biết cái sDic nối chuỗi này nó dài tới đâu và lúc nào sẽ báo lỗi?
Đã cất công đặt sDic rồi sao không khai báo nó thành Dictionary luôn?

Nghe nói chuỗi trong VBA có thể là ~2 tỷ ký tự. Giả sử là 1 triệu ô khác nhau, mỗi ô phải chứa ~2000 ký tự thì chắc mới có thể lỗi.
File của bài 1, 1 ô chưa đến 100 ký tự nên chắc là không vấn đề

 

[AnhThu-1976]

Nghe nói chuỗi trong VBA có thể là ~2 tỷ ký tự. Giả sử là 1 triệu ô khác nhau, mỗi ô phải chứa ~2000 ký tự thì chắc mới có thể lỗi.
File của bài 1, 1 ô chưa đến 100 ký tự nên chắc là không vấn đề

Dữ liệu của em khoảng 1.000 ô, mỗi ô khoảng 5 ký tự