Met Excel-VBA een cel kleuren afhankelijk van de inhoud van de cel?

Met voorwaardelijke opmaak heb ik dit voor elkaar. Als er 'A' staat dan moet de cel blauw kleuren (kleurnr. 15773696), etc. Zo zijn er in totaal 5 kleuren. Het gekke is dat je deze kleur niet geselecteerd ziet bij Start - Lettertype - Opvulling.
Deze kleuren kunnen per cel verschillend in een bereik. Zo moet elke cel in het bereik worden onderzocht op de inhoud ('A', 'H', 'N' of 'X') en daar moet dan de juiste 'harde' kleur komen. Als deze cel dan is ingekleurd door de VBA-code (middels een macro) en ik verander vervolgens de waarde van de cel dan moet de kleur blijven staan (vandaar de term 'harde kleur'). In tegenstelling tot de 'softe' kleur door de 'Voorwaardelijke opmaak'. De kleurnrs voor H, N en X vul ik zelf later wel in.

Vraag: hoe maak ik zo'n VBA-code dat cellen in een bereik één-voor-één gaat onderzoeken en kleuren. Bv A1:D20

Ik heb al een macro gemaakt dat 1 cel blauw kleurt zonder naar de inhoud van de cel te kijken:

Sub Kleur_de_cel_blauw()
'
' Kleur_de_cel_blauw Macro
'

'
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub

Weet jij het antwoord?

/2500

Het beste antwoord

Hier is een routine die de kleur verandert als je de waarde van een cel verandert alleen als deze wit is. Je moet zelf de waarden nog invullen. Je kunt er nog wat toeters en bellen in aanbrengen om te zorgen dat hij niet steeds het hele blad hoeft door te spitten. Private Sub Worksheet_Change(ByVal Target As Range) Dim R&, C& For R = Sheet1.UsedRange.Row To Sheet1.UsedRange.Row + Sheet1.UsedRange.Rows - 1 For C = Sheet1.UsedRange.Column To Sheet1.UsedRange.Column + Sheet1.UsedRange.Columns - 1 If Range(Cells(R, C)).Interior.Color = vbWhite Then If Cells(R, C) = "" Then Range(Cells(R, C)).Interior.Color = "" ElseIf Cells(R, C) = "" Then Range(Cells(R, C)).Interior.Color = "" ElseIf Cells(R, C) = "" Then Range(Cells(R, C)).Interior.Color = "" End If End If Next Next End Sub

Stel zelf een vraag

Ben je op zoek naar het antwoord die ene vraag die je misschien al tijden achtervolgt?

/100