Zavrieť

Porady

COUNTA podľa farby textu

Zdravím vás;

Už dlhšie hľadám na nete vzorec, ktorý by vedel zrátať bunky, ktoré obsahujú text s určitou farbou. Nemyslím ale sumu buniek(SUM), ale počet buniek(COUNT).
Našiel som už vzorec ktorý to zvládol, ale počíta aj naformátované bunky, v ktorých nieje napísané nič, ale predsa majú definovanú farbu textu.
Modul vzorca vyzerá takto:

Code:
Function CountColor(InRange As Range, ColorIndex As Long, _
    Optional OfText As Boolean = False) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CountColor
' This function counts the cells in InRange whose ColorIndex
' is equal to the ColorIndex parameter. The ColorIndex of the
' Font is tested if OfText is True, or the Interior property
' if OfText is omitted or False. If ColorIndex is not a valid
' ColorIndex (1 -> 56, xlColorIndexNone, xlColorIndexAutomatic)
' 0 is returned. If ColorIndex is 0, then xlColorIndexNone is
' used if OfText is Fasle or xlColorIndexAutomatic if OfText
' is True. This allows the caller to use a value of 0 to indicate
' no color for either the Interior or the Font.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim R As Range
Dim N As Long
Dim CI As Long

If ColorIndex = 0 Then
    If OfText = False Then
        CI = xlColorIndexNone
    Else
        CI = xlColorIndexAutomatic
    End If
Else
    CI = ColorIndex
End If


Application.Volatile True
Select Case ColorIndex
    Case 0, xlColorIndexNone, xlColorIndexAutomatic
        ' OK
    Case Else
        If IsValidColorIndex(ColorIndex) = False Then
            CountColor = 0
            Exit Function
        End If
End Select

For Each R In InRange.Cells
    If OfText = True Then
        If R.Font.ColorIndex = CI Then
            N = N + 1
        End If
    Else
        If R.Interior.ColorIndex = CI Then
            N = N + 1
        End If
    End If
Next R

CountColor = N

End Function
Možno by to šlo aj cez funkciu COUNTA, ale zas treba nejaký ďalší vzorec navyše...

Prosím poraďte
Pravidlá a tipy
  • Každý móže napísať len 1 odpoveď. Neskor mozete svoju odpoveď vylepšiť.
  • Odpoveď má priniesť riešenie na otázku, vyvarujte sa hodnotenia otázky.
  • Odpoveď má byť viac o faktoch ako o názoroch.
Dalšie pravidla a tipy
    Ak potrebujete v otázke niečo upresniť, najskôr sa spýtajte na podrobnosti.
    Koncept slúži na uloženie rozpracovanej odpovede, koncept sa zobrazuje len Vám, až kým ho nezverejníte.
    Ak máte podobnú otázku, založte Novú otázku alebo Súvisiacu otázku.
    ❤ Buďte priateľskí ❤
    Sme súčasťou jednej komunity, ktorá si chce vzájomne pomáhať, rozdieľnosť je vítaná ak neubližuje!
    Usporiadať podľa času

    MrGee je offline (nepripojený) MrGee

    MrGee
    Po dlhom dni hľadania, snorenia a vypytovania sa na fórach od výmyslu sveta, som sa dopracoval k odpovedi

    Code:
    For Each r In InRange.Cells
        If OfText = True Then
            If r.Font.ColorIndex = CI And r.Value <> "" Then
                N = N + 1
            End If
        Else
            If r.Interior.ColorIndex = CI And r.Value <> "" Then
                N = N + 1
            End If
        End If
    Next r

    Kabaka123 je offline (nepripojený) Kabaka123

    Kabaka123
    posúvam.... pre mňa geniálny objav... súčet buniek a počet buniek podľa farby už aj v exceli 2003 s nástrojom Rj tools... od Radeka Jurečka geniálna vec...

    http://www.rjurecek.cz/excel/rj-tools/
    Chobot To koľkokrát tu chceš pridať túto reklamu?
    Kabaka123 už stačilo...

    COUNTA podľa farby textu

    Porady, ktoré by vás mohli zaujímať

    Prihláste sa a sledujte len tie Porady, ktoré Vás zaujímajú.