Skús do VBA nakopírovať a spustiť nasledujúcu procedúru:
Sub CountColorValue()
Dim numbersBas As Long, numbersAdv As Long, numbersInt As Long, lastrow As Long
Dim rng As Range, c As Range
'Nájdi posledný riadok
lastrow = Range("A" & Rows.Count).End(xlUp).Row
'Urči oblasť buniek
Set rng = Range("A1:A" & lastrow)
'prejdi oblasť buniek
For Each c In rng
'If the interior color is 6 (standard yellow), not blank and not a number
If c.Value = "basic" And c.Interior.ColorIndex = 6 Then
'basic
numbersBas = numbersBas + 1
ElseIf c.Value = "advanced" And c.Interior.ColorIndex = 6 Then
'advanced
numbersAdv = numbersAdv + 1
ElseIf c.Value = "intermediate" And c.Interior.ColorIndex = 6 Then
'intermediate
numbersInt = numbersInt + 1
End If
Next c
'Message box popis + počet
MsgBox "Yellow + basic " & numbersBas & Chr(13) & _
"Yellow + advanced " & numbersAdv & Chr(13) & _
"Yellow + intermediate " & numbersInt
End Sub
Žiaľ odmieta mi to tu upnúť upravený súbor (Upload failed).
Stiahni si ho z:
https://uloz.to/!pzLN2y7i7sj6/countcolor-upr-xlsm
Úprava je na Hárku 2.