door voorwaardelijke opmaak gekleurde cellen tellen.

[Wirelma]

In de bijlage 2 tabbladen uit een groter bestand. Het betreft een resultatenlijst voor een biljartcompetitie.
Het probleem wat ik heb ligt op regel 66 en 67. In de kolommen daarboven staan per speler eerst de caramboles, de aantal beurten, het gemiddelde en het aantal punten waar de speler recht op heeft(dat laatste a.d.h.v. tabblad 3).
Scoort hij een seizoenhoogterecord dan zal de cel met het gemiddelde (3e cel achter de naam) groen kleuren middels voorwaardelijke opmaak. Scoort hij een seizoendiepterecord dan kleurt de cel rood.
Nu wil ik graag op regel 66 en 67 de aantallen resp. groene en rode cellen tellen. Maar dat krijg ik niet voor elkaar.
Kan iemand mij helpen.

Ik heb nog niet eerder gebruik gemaakt van dit forum dus hoop ik dat ik duidelijk genoeg ben en dat ik juist handel.

 

[Severijns]

Wirelma,

Ik heb vorige maand net zo'n vraag gesteld.
Zoek maar eens op:

"Blauwe cellen met rode tekst tellen" en "Gekleurde cellen (VO) tellen"


Hoop dat het voldoende voor je is.


Rob

 

[Wirelma]

Ik heb ze gelezen. Ik zie mijn probleem toch anders. Of het moet al aan VBA liggen want daar heb ik geen kaas van gegeten. Maar misschien is dat wel de enige oplossing.

 

[Severijns]

Wirelma,

Ook ik ben geen ster in VBA maar denk wel dat je daar op uit gaat komen.
Ga nu echter eerst van mijn nachtrust genieten.
Zal morgen kijken of ik je wellicht verder kan helpen maar dat wordt niet eerder als morgenmiddag.

Rob

 

[Severijns]

Wirelma,

Ik ben aan het stoeien geweest met een stukje code dat ik ooit via Edmoor heb gekregen.
Heb daar wat aanpassingen aan gedaan maar helaas krijg ik het niet werkend.
Ben zoals ik al zei geen ster met VBA.

Sub Bereken_Totalen()
    
    Cancel = True
    
    For x = 1 To 2
        Select Case x
            Case 1: Klr = "B66"
            Case 2: Klr = "B67"
        End Select
        
        For i = 3 To 18
            Select Case x
                Case 1: Ant = Cells(66, i).Address(0, 0)
                Case 2: Ant = Cells(67, i).Address(0, 0)
            End Select
            
            cellen = Split(Cells(3, i).Address, ":")(0) & ":" & Split(Cells(62, i).Address, ":")(0)
            On Error Resume Next
            Set Rng = Range(cellen).SpecialCells(xlCellTypeConstants)
            aantal = 0

        If Not Rng Is Nothing Then
    
        For Each cl In Rng
            If Not cl.Rows.Hidden Then
                If cl.DisplayFormat.Interior.Color = Range(Klr).Interior.Color And cl.DisplayFormat.Font.Color = Range(Klr).Font.Color Then
                   If IsNumeric(cl.Value) And cl.Value > 0 Then
                        aantal = aantal + 1
                 End If
                End If
            End If
        Next
    End If
            
            On Error GoTo 0
            Range(Ant).Value = aantal
            Set Rng = Nothing
        Next i
    Next x

End Sub

Ik heb een getal in jouw cellen B66 en B67 gezet maar en de tekst kleur op automatisch gezet maar dat werkte helaas niet.

If IsNumber(cl.Value) And cl.Value > 0 Then

werkte helaas ook niet.
Wellicht dat iemand anders je er mee verder kan helpen.
Succes,


Rob

 

[WHER]

Mits een kleine aanpassing aan de macro uit post 5:

 

[Severijns]

Hallo WHER,

Bedankt. Ik zie nu waar ik de fout in ging.
Ik was wel al een eind op de goede weg dus dat stemt mij tevreden.
Nu maar hopen dat Wirelma dat ook is.

Groet,

Rob

 

[Wirelma]

Helaas. Hij heeft wel van de ingevulde cellen de gekleurde geteld maar als ik voor de volgende spelronden de aantal caramboles invul en de aantal beurten (het gemiddelde en de daarbij horende punten verschijnen dan) dan worden de eventuele rode of groene cellen niet geteld.

andere opmerking: ik had een bericht in mijn mailbox verwacht als er antwoord was maar dat mis ik. Daarom ben ik nu zo laat met reageren.

 

[Severijns]

Hoi Wirelma,

De code doet wel degelijk zijn werk.
Wel zal je de code moeten aanroepen.
Ik zal morgen even aangeven hoe je dat kunt doen mocht je er zelf niet uitkomen.

Rob

 

[Wirelma]

Graag. Ik kan zelfs geen code vinden. Niet met Alt F8 en ook niet Alt F11.

 

[Severijns]

Wirelma,

Ik heb in jouw document een opdrachtknop gemaakt die de code aanroept voor het berekenen van de totalen.
De code staat in Module1 en de aanroep staat op het werkblad "Groene Laken 1"
De aanroep van de code kun je ook aan de andere gewenste werkbladen toevoegen.
Zorg er dan wel voor dat de te berekenen velden identiek zijn.
Overigens zou de toets combinatie Alt/F11 gewoon moeten werken.

Rob

Bekijk bijlage GroeneLaken.xlsm

 

[Wirelma]

dit is 'm. Geweldig. Nu moet ik het nog omzetten naar het oorspronkelijke bestand.

Iedereen bedankt, die hieraan heeft meegewerkt.

 

[Severijns]

Wirelma,

Fijn om te horen dat jouw probleem is opgelost.:thumb:
Vergeet niet de vraag als opgelost te markeren (rechts boven in de thread)

Rob