[Excel] gekleurde cellen met opmaak tellen

[smoothvision]

Hallo helpers :thumb:,

Ik had een vraag over het volgende waar ik maar niet uit kom.
Ik heb in excel een krantenlooplijst gemaakt waarin een x aantal kranten vermeld staan.

De kranten hebben een kleur en daar kun je ze dus aan herkennen, maar sommige kranten hebben dezelfde kleur achtergrond als een andere krant maar die hebben een rand om de cel (rood of zwart, helemaal of gestippeld)

Nu is het zo dat ik per krant de aantallen automatisch wil laten optellen en de uitkomst in een vakje achter de krant naam zetten.

In VBA heb ik de volgende code samengesteld, die dus selecteerd op achtergrond, dit werkt perfect, alleen nu telt hij de cellen op die de zelfde achtergrond hebben, maar wel verschillen dmv bijvoorbeeld een rand rondom de cel.
Zie voorbeeld in het toegevoegde excel sheet.

Public Function SomKleur(Optelbereik As Range, referentie As Range) As Double
    Application.Volatile
    Dim totaal As Double, kleur As Long
    Dim c As Range
    
    kleur = referentie.Interior.ColorIndex
    For Each c In Optelbereik.Cells
        If c.Interior.ColorIndex = kleur Then
            totaal = totaal + 1
        End If
    Next c
    
    SomKleur = totaal
End Function

Is het mogelijk om de bovenstaande code aan te passen dat het ook kijkt naar de celopmaak van een cel zodat hij wel onderscheid kan maken tussen de cellen met de zelfde achtergrond maar waarvan 1 bv. een rand rondom de cel heeft??

Het zou denk ik iets moeten zijn in deze regel, na kleur.

If c.Interior.ColorIndex = kleur Then

maar geen idee hoe ik dan voor elkaar krijg, hopelijk bied de bijlage meer opheldering!
Zijn er toch nog vragen of dingen die niet duidelijk zijn, hoor ik het graag

 

[LucB]

smoothvision,

Kijk eens of dit iets voor je is.

 

[Sjaan99]

In de code staat

'als je + 1 vervangt door + Val(cel) krijg je de Som ipv Aantal

maar dat werkt niet. Dit zou namelijk precies zijn waar ik naar op zoek ben.

Sjaan

 

[Wigi]

De code zou veel korter kunnen, het is ook niet mijn code: maar dit werkt volgens mij:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim R      As Range
    Dim cel    As Variant
    Dim teller As Long
    'als je +Val(cel) vervangt door + Val(cel) krijg je de Som ipv Aantal
    Application.EnableEvents = False
    teller = 0
    Set R = Range("B2:P26")
    For Each cel In R
        If cel.Interior.ColorIndex = Range("I32").Interior.ColorIndex Then
            teller = teller + Val(cel) '+Val(cel) 'Val(cel)
        End If
    Next
    [i32] = teller
    teller = 0
    Set R = Nothing
    Set R = Range("B2:P26")
    For Each cel In R
        If cel.Interior.ColorIndex = Range("I31").Interior.ColorIndex Then
            teller = teller + Val(cel) 'Val(cel)
        End If
    Next
    [i31] = teller
    teller = 0
    Set R = Nothing
    Set R = Range("B2:P26")
    For Each cel In R
        If cel.Interior.ColorIndex = Range("I30").Interior.ColorIndex Then
            teller = teller + Val(cel) 'Val(cel)
        End If
    Next
    [i30] = teller
    teller = 0
    Set R = Nothing
    Set R = Range("B2:P26")
    For Each cel In R
        If cel.Interior.ColorIndex = Range("I29").Interior.ColorIndex Then
            teller = teller + Val(cel) 'Val(cel)
        End If
    Next
    [i29] = teller
    teller = 0
    Set R = Nothing
    Set R = Range("B2:P26")
    For Each cel In R
        If cel.Interior.ColorIndex = Range("I28").Interior.ColorIndex Then
            teller = teller + Val(cel) 'Val(cel)
        End If
    Next
    [i28] = teller
    teller = 0
    Set R = Nothing
    Application.EnableEvents = True

End Sub

Wigi