MrGee
25.06.10,16:31
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:


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
MrGee
26.06.10,08:00
Po dlhom dni hľadania, snorenia a vypytovania sa na fórach od výmyslu sveta, som sa dopracoval k odpovedi:)


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
02.04.15,17:06
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
02.04.15,19:51
To koľkokrát tu chceš pridať túto reklamu?
Kabaka123
03.04.15,05:22
už stačilo...:)