Aantal van dezelfde kleur tellen in Kolom B die bij de waarde hoort in kolom A

[wjgvanooijen]

Ik heb in een module de volgende VBA code geplaatst om het aantal blauwe cellen te tellen:

------------------------------------------------------------------------
Function TelKleur(R As range, CelKleur As range) As Integer
Dim C As Object, Kleur As Integer
Kleur = CelKleur.Interior.ColorIndex
TelKleur = 0
For Each C In R
If C.Interior.ColorIndex = Kleur Then TelKleur = TelKleur + 1
Next
End Function
------------------------------------------------------------------------

Formule in E3: =telkleur(B2:B11;D3)

Ik zou echter willen dat alle blauwe kleuren in kolom B geteld worden die horen bij de waarde 320 in kolom A. Weet iemand een manier om de formule =telkleur(B2:B11;D3) zo aan te passen dat dit gaat werken?

Zie bijlage Bekijk bijlage test kleur.xlsm

 

[edmoor]

Als dat een vast gegeven is gaat dat zo:

Function TelKleur(R As Range, CelKleur As Range) As Integer
    Dim C As Object
    For Each C In R
        If C.Interior.ColorIndex = CelKleur.Interior.ColorIndex Then
            If Cells(C.Row, 1) = 320 Then
                TelKleur = TelKleur + 1
            End If
        End If
    Next
End Function

Als je het in de aanroep wilt meegeven doe je dat zo:

Function TelKleur(R As Range, CelKleur As Range, Kolom As Integer, Waarde As Integer) As Integer
    Dim C As Object
    For Each C In R
        If C.Interior.ColorIndex = CelKleur.Interior.ColorIndex Then
            If Cells(C.Row, Kolom) = Waarde Then
                TelKleur = TelKleur + 1
            End If
        End If
    Next
End Function

De aanroep is dan:
=TelKleur(B2:B11;D3;1;320)


*Tevens de variabele Kleur verwijderd.

 

[wjgvanooijen]

Werkt perfect, zoek nog naar een extra mogelijkheid

Bedankt voor de informatie. Ik ben er bijna uit met de onderstaande code.

Function TelKleur(R As Range, CelKleur As Range, Kolom As Integer, Waarde As Integer) As Integer
Dim C As Object
For Each C In R
If C.Interior.ColorIndex = CelKleur.Interior.ColorIndex Then
If Cells(C.Row, Kolom) = Waarde Then
TelKleur = TelKleur + 1
End If
End If
Next
End Function

Ik mis eigenlijk nog de mogelijkheid om de uitkomst in een ander tabblad te plaatsen/tabbladverwijzing te gebruiken. Dit is vooral erg handig wanneer er gefilterd moet worden. Dan blijven alle gegevens overzichtelijk bij elkaar staan

De formule =TelKleur(B2:B11;D3;1;320) zou er dan ongeveer zo uit kunnen zien =TelKleur('Ronde 1'!B2:B11;D3;1;320)

Weten jullie een oplossing?

 

[edmoor]

Ook dat kan:

Function TelKleur(R As Range, CelKleur As Range, Kolom As Integer, Waarde As Integer) As Integer
    Dim C As Object
    For Each C In R
        If C.Interior.ColorIndex = CelKleur.Interior.ColorIndex Then
            If Sheets(C.Worksheet.Name).Cells(C.Row, Kolom) = Waarde Then
                TelKleur = TelKleur + 1
            End If
        End If
    Next
End Function

De aanroep is dan:
=TelKleur(Blad1!B2:B8;Blad1!D3;1;320)

P.S.
Gebruik code tags als je code plaatst.

 

[Cobbe]

Met deze aanpassing lukt dat wel:

Function TelKleur(R As Range, CelKleur As Range, Kolom As Integer, Waarde As Integer) As Integer
Dim C As Object
For Each C In R
If C.Interior.ColorIndex = CelKleur.Interior.ColorIndex Then
If Sheets("Blad1").Cells(C.Row, Kolom) = Waarde Then
TelKleur = TelKleur + 1
End If
End If
Next
End Function

=TelKleur(Blad1!B2:B11;Blad1!D3;1;320)