• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

gekleurde cellen tellen fout

Status
Niet open voor verdere reacties.

dirkc

Gebruiker
Lid geworden
22 jun 2013
Berichten
25
Beste,

Ik heb een tabel waar gekleurde cellen instaan.
Ik wil het aantal cellen van een bepaalde kleur in elke kolom optellen.

Dit lukt me voor 3 van de 5 kleuren (groen/geel/blauw), maar orange en rood worden als 1 kleur bekenen. (zie voorbeeld)
Het zijn geen standaardkleuren doordat deze door een ander programma naar een excelbestand worden omgezet.

Mijn vragen :
1 . hoe komt het dat vba deze kleur niet kan onderscheiden?
2. Is er (indien nodig) een mogelijkheid om een cel automatisch (al dan niet vba) van kleur te doen veranderen : bv als een cel orange is, kleur deze dan grijs..
3. De tabel waar mee gewerkt moet worden is variabel : dwz..de ene keer zijn er 4 kolommen, de andere keer 8. Hoe selecteer ik de laatst gevulde cel en dan automatisch 2 rijen hoger?
bv laatste kolom waar iets instaat is k10. nu wil ik vba auto laten kijken naar de laatst gevulde cel in rij 10, en dan 2 rijen hoger (k8) 'iets' laten schrijven

Bijgevoegd voorbeeld geeft duidelijk zicht over de problemen

In mijn VBA code zit wel wat amateurgeknoei :p

Alvast bedankt !Bekijk bijlage klvraag.xlsm
 
Heb het UDF-je lichtjes gewijzigd:

Code:
Function GetColorCount(CountRange As Range, CountColor As Range)


    Dim CountColorValue As Long
    Dim totalcount As Integer
    CountColorValue = CountColor.Interior.Color
    Set rCell = CountRange
    For Each rCell In CountRange
        If rCell.Interior.Color = CountColorValue Then
        totalcount = totalcount + 1
       End If
    Next rCell
    GetColorCount = totalcount
End Function
 
Met wat aanpassingen krijg ik wel werkend.

Code:
Function GetColorCount(CountRange As Range, CountColor As Range)


    Dim CountColorValue As Double
    Dim totalcount As Double
    
    CountColorValue = CountColor.Interior.Color
    
    Set rCell = CountRange
    For Each rCell In CountRange
        If rCell.Interior.Color = CountColorValue Then
        totalcount = totalcount + 1
       End If
    Next rCell
    GetColorCount = totalcount
End Function
 
Laatst bewerkt:
wow!!
beiden bedankt voor de snelle reactie !!
begrijp nie echt waar het foutliep, maar de 2 oplossingen werken idd perfect.

mijn 2e vraag is dus overbodig:)
mss nog tipje voor vraag 3?
 
Er van uitgaande dat in A10 geen waarde staat:
Code:
Cells(10, 2).End(xlToRight).Offset(-2, 0).Value = "iets"

En volgens mij ging het fout omdat je verwijst naar de colorindex. Die kent maar 56 kleuren, dus waarschijnlijk ziet VBA alle kleuren die niet bij deze 56 horen, allemaal als dezelfde kleur.
 
Laatst bewerkt:
mss verkeerd uitgelegd

dat is het probleem...

soms is f10 de laatste beschreven cel , som k10 , som l10

dus het aantal kolommen is variabel
maar ik wil dit wel enkel bekijken in rij10, onder rij 10 staat de rest van de tabel, erboven een 'hoofding' en net daar wil ik iets schrijven

Hoe vertaal ik dan 'kijk naar de laatst gevulde cel in rij10 en schrijf in die kolom 2 rijen hoger"iets"

(dus als in dat geval laatste cel k10 zou zijn, schrijf dan in "k8" iets)

En idd die colorindex lijkt logische verklaring :)
 
Laatst bewerkt:
Dirk,

Ik weet niet of ik je snap, maar probeer deze eens:

Code:
Sub Iets()

Dim Eind As Integer
With ActiveSheet
    Eind = .Cells(10, .Columns.Count).End(xlToLeft).Column
End With
    
Cells(8, Eind).Value = "iets"
End Sub
 
dit is idd de bedoeling :)
hier kan ik weer verder mee teste !
thx
(denk dat er mss nog struikelblokken volgen....maar dan start ik mss best nieuwe vraag)
 
Alle onnodige variabelen zijn onnodig net als alle selects en alle overbodige code;) Wel bijzonder dat je data aangeleverd krijgt in kleurtjes....

Code:
Function GetColorCount(CountRange As Range, CountColor As Range)
  For Each cl In CountRange
    If cl.Interior.Color = CountColor.Interior.Color Then GetColorCount = GetColorCount + 1
  Next cl
End Function

Code:
Sub Iets()
  Cells(8, Cells(10, Columns.Count).End(xlToLeft).Column).Value = "iets"
End Sub

Code:
Sub ttt()
ar = Array(RGB(152, 251, 152), RGB(240, 128, 128), RGB(255, 255, 0), RGB(244, 164, 96), RGB(135, 206, 235))
  For j = 0 To 4
    Cells(j + 3, 2).Interior.Color = ar(j)
  Next j
  Range("B3").Resize(5, Cells(10, Columns.Count).End(xlToLeft).Column - 1) = "=GetColorCount(R10C:R50C,RC2)"
End Sub
 
Dit is idd een mooie opkuis en hoe mooier een macro, hoe liever ik die gebruik natuurlijk :)

Maar ik stuit hier toch op een 'klein' probleem.
Ik open verschillende macro's onder 1 knop. zo :

option explicit
-----------------------

Sub startmacro()

emplo
train
kleur
opslaan
end sub
-----
hieronder staan dan verder de subs die gebruikt moeten worden

Nu als ik die 'option explicit' laat staan krijg ik fout melding op bovenstaande code (sub ttt) "een variabele is niet gedefinieerd"....nl "ar... wat schrijf ik dan om te declareren? dim ar=.....?
Als ik die 'option explicit" echter weglaat, werkt het wel.. Andere variablen in mijn macro's zijn dus correct gedeclareerd of kan in die op gewoon verwijderen?
 
Dim ar As Variant (As Variant mag je ook weglaten)
 
Perfect !!
Allemaal bedankt voor de hulp , en tot het volgende probleem :)
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan