Gekleurde cellen tellen

[verluc]

Vond volgende marco op dit forum :

Sub AllesTellen()
Dim c As Range
For Each c In [B1:X31]
If c.Interior.ColorIndex = 3 Then
[B33].Value = [B33].Value + 1
End If
Next
End Sub

Indien men deze macro tweemaal laat lopen, dan word natuurlijk de telling ook dubbel uitgevoerd.Hoe deze teller eerst op "nul" plaatsen vooraleer deze macro uit te voeren.

Kan deze macro ook aangepast worden voor drie of meer kleuren met als totaal op bijvoorbeeld C33 D33 enz.

Dank voor alle hulp bij voorbaat.

 

[Roncancio]

Sub AllesTellen()
Dim c As Range
[B33].Value = 0
       For Each c In [B1:X31]
            If c.Interior.ColorIndex = 3 Then
                [B33].Value = [B33].Value + 1
            ElseIf c.Interior.ColorIndex = 4 Then
                [C33].Value = [C33].Value + 1
            ElseIf c.Interior.ColorIndex = 5 Then
                [D33].Value = [D33].Value + 1
            End If
       Next
End Sub

Er zijn meerdere manieren maar ik heb de code zo veel mogelijk intact gelaten zodat je deze zelf (makkelijk?) kan aanpassen.

Met vriendelijke groet,

Roncancio

 

[trucker10]

Roncancio , ik vermoed dat je dit ook had willen kenbaar maken

Sub AllesTellen()
Dim c As Range
[B33[COLOR="Red"],C33,D33[/COLOR]].Value = 0
       For Each c In [B1:X31]
            If c.Interior.ColorIndex = 3 Then
                [B33].Value = [B33].Value + 1
            ElseIf c.Interior.ColorIndex = 4 Then
                [C33].Value = [C33].Value + 1
            ElseIf c.Interior.ColorIndex = 5 Then
                [D33].Value = [D33].Value + 1
            End If
       Next
End Sub

 

[Roncancio]

Klopt:thumb:

Sub AllesTellen()
Dim c As Range
[[COLOR="Red"][B]B33:D33[/B][/COLOR]].Value = 0
       For Each c In [B1:X31]
            If c.Interior.ColorIndex = 3 Then
                [B33].Value = [B33].Value + 1
            ElseIf c.Interior.ColorIndex = 4 Then
                [C33].Value = [C33].Value + 1
            ElseIf c.Interior.ColorIndex = 5 Then
                [D33].Value = [D33].Value + 1
            End If
       Next
End Sub

Maar ik zou dan wel gebruik maken van een Range.

Met vriendelijke groet,


Roncancio

 

[huijb]

@jack009 Graag een eigen vraag maken a.u.b. Het is niet netjes om in een ander zijn of haar vraag jouw probleem aan de orde te stellen. Bovendien is het verwarrend voor de helpers.

 

[snb]

Of

Sub AllesTellen()
  [B33:D33].Value = 0
  For Each cl In [B1:X31]
    cells(33,cl.interior.colorindex-1)=cells(33,cl.interior.colorindex-1)+1
  Next
End Sub

 

[jack009]

@jack009 Graag een eigen vraag maken a.u.b. Het is niet netjes om in een ander zijn of haar vraag jouw probleem aan de orde te stellen. Bovendien is het verwarrend voor de helpers.

zal ik voortaan doen

excuses

 

[jack009]

Of

Sub AllesTellen()
  [B33:D33].Value = 0
  For Each cl In [B1:X31]
    cells(33,cl.interior.colorindex-1)=cells(33,cl.interior.colorindex-1)+1
  Next
End Sub

bedankt voor de reaktie

groet

 

[danny147]

Beste verluc

Zonder ook maar één antwoord te geven of een bedanking vind ik dit jammer voor alle helpers aan deze topic doe zo hard hun best doen om dit tot een goed einde te brengen.

Er wordt verwacht dat de topicsteller steeds de laatste is in deze topic.

Groetjes Danny. :thumb:

 

[verluc]

Inderdaad, volledig akkoord.
Had deze topic op "afgehandeld" geplaatst , echter zonder eerst mijn bedanking in deze te laten kennen aan de deelnemers in dit onderwerp.
Vandaar mijn welgemeende excuses en dank.