Kleur tellen

[Jack Nouws]

Hallo

Met deze code worden alle geel gekleurde cellen in het bereik D4:M31 allemaal netjes opgeteld in cel P16.

Sub AllesTellen()
Dim c    As Range
    
        For Each c In [D4:M31]
            If c.Interior.ColorIndex = 6 Then
                [P16].Value = [P16].Value + 1
            End If
        Next

End Sub

Maar nu wil ik alle geel gekleurde cellen in het bereik D4:M31 per rij opgetelt zien in de P kolom. Ik ben er el mee bezig geweest maar ik kom er niet helemaal aan uit. Wie kan me verder helpen?

Sub KleurTellen()
Dim i       As Integer
Dim c       As Range
    
    For i = 4 To 31
        For Each c In Rows(i)
            If c.Interior.ColorIndex = 6 Then
                Rows(i, 16).Value = Rows(i, 16).Value + 1
            End If
        Next c
     Next i
        
End Sub

 

[Wigi]

For Each c In Range("D" & i, "M" & i)

 

[Jack Nouws]

For Each c In Range("D" & i, "M" & i)

Dank U wel Wigi,
Het werkt

Sub KleurTellen()
Dim i       As Integer
Dim c       As Range
    
    For i = 4 To 31
        For Each c In Range("D" & i, "M" & i)
            If c.Interior.ColorIndex = 6 Then
                cells(i, 16).Value = cells(i, 16).Value + 1
            End If
        Next c
     Next i
        
End Sub

Heb ik nog een vraagje, hoe kun je deze kleuren tellen als deze kleuren door de voorwaardelijke opmaak zijn bepaald? Ik dacht hieraan maar dat werkt niet.

Sub RijKleurTellen()
Dim i       As Integer
Dim c       As Range
Application.ScreenUpdating = False

    For i = 4 To 31
        For Each c In Range("D" & i, "M" & i)
        If c.FormatConditions(1).Interior.ColorIndex = 6 Then
                cells(i, 16).Value = cells(i, 16).Value + 1
            End If
        Next c
     Next i
     
Application.ScreenUpdating = True
End Sub

Met vr gr
Jack

 

[trucker10]

Heb ik nog een vraagje, hoe kun je deze kleuren tellen als deze kleuren door de voorwaardelijke opmaak zijn bepaald? Ik dacht hieraan maar dat werkt niet.
Met vr gr
Jack

Jack , op deze link staat een duidelijke uitleg met code

 

[Jack Nouws]

Jack , op deze link staat een duidelijke uitleg met code

Dan zal het met deze code moeten lukken, maar mij alleen zal dat niet lukken.
Hoe krijg ik deze code gecombineerd met mijn code?

Function SumByCFColorIndex(Rng As Range, CI As Integer) As Double
    Dim R As Range
    Dim Total As Double
    
    For Each R In Rng.cells
        If ColorIndexOfCF(R, False) = CI Then
            Total = Total + R.Value
        End If
    Next R
    SumByCFColorIndex = Total
End Function

Met vr gr
Jack

 

[trucker10]

Dan zal het met deze code moeten lukken, maar mij alleen zal dat niet lukken.
Hoe krijg ik deze code gecombineerd met mijn code?
Met vr gr
Jack

Jack , ik denk dat je een function niet in een macrocode kan verwerken ( mergen ) voor zover ik snap .

 

[Jack Nouws]

Jack , ik denk dat je een function niet in een macrocode kan verwerken ( mergen ) voor zover ik snap .

Ik denk dat het wel kan volgens deze link
Maar zoals hun daar al aangeven is het een lastige aanpak.

(... maar watch out... quite difficult... )

Ik denk dat ik er maar vanaf zal zien.

Met vr gr
Jack

 

[trucker10]

Ik denk dat het wel kan volgens deze link
Maar zoals hun daar al aangeven is het een lastige aanpak.
Ik denk dat ik er maar vanaf zal zien.

Met vr gr
Jack

Jack een foutje in de link , ik krijg de error page te zien

 

[Jack Nouws]

Jack een foutje in de link , ik krijg de error page te zien

link

 

[Wigi]

Tel de cellen met kleur door de logica die in de voorwaardelijke opmaak vervat zit, in VBA te gebruiken als voorwaarden om te tellen / sommeren.

 

[Jack Nouws]

Tel de cellen met kleur door de logica die in de voorwaardelijke opmaak vervat zit, in VBA te gebruiken als voorwaarden om te tellen / sommeren.

Phoe dat is een lastige voor me. Ikben tot hier gekomen en verder lukt het me niet.

Sub RijKleurTellen()
Dim i       As Integer
Dim c       As Range
Application.ScreenUpdating = False

    For i = 4 To 31
        For Each c In Range("D" & i, "M" & i)
        With c
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:="=AANTAL.ALS($D$35:$I$47;D4)>0"
            .FormatConditions(1).Interior.ColorIndex = 6
            cells(i, 16).Value = cells(i, 16).Value + 1
            End With
        Next c
     Next i
     
Application.ScreenUpdating = True
End Sub

Ik loop hier echt op vast want om de code goed te laten werken moet ik eerst het bereik D4 t/m M31 selecteren.

Met vr gr
Jack

 

[Ginger]

Jack Nouws, Om die functie te van de site van C.Pearson te laten werken, moet je ALLE functies mee overnemen naar je eigen workbook. In de functie SumByCFColorIndex die je in post nr 5 aangeeft, wordt de functie ColorIndexOfCF aangeroepen. En zelfs in die aangeroepen functie zit vervolgens nóg een aanroep naar de functie ActiveCondition....
Probeer dus aub wel te begrijpen waar je mee bezig bent! Code is namelijk net als een moeilijk boek. Lees je maar de helft, zal je nooit begrijpen wie 'wat' en 'waarom' heeft gedaan!

Groet, Leo