karakters toevoegen met een andere kleur

[jakko1972]

Ik heb het volgende probleem.

Ik heb gegevens die veranderen die allemaal in een cel moeten komen te staan. Als een karakter wordt toegevoegd dan moet deze de witte kleur krijgen. Indien de karakter al eerder daar stond krijgt het de kleur zwart.
Op zich de karakters toevoegen is geen probleem, ook het wijzigen van de kleur is geen probleem.

Wat is dan wel het probleem? Wanneer ik de variabele toevoeg met een nieuwe variabele dan overschrijft hij alle kleuren. Hoe kan ik dit voorkomen?

Voorbeeld van waarden van een cel.
1, 2, 3, 4, 5
nu wil ik de cijfers 2 en 4 wit en de rest zwart.
Natuurlijk kan het in een ander voorbeeld 1, 3, 4 wit zijn.

Onderstaande heb ik al geschreven en is een gedeelte van het hele programma. Wie kan mij helpen.

If Worksheets("RisicoMatrix").Range(strrange) <> "" Then
Range(strrange).Select
numbercount = Len(Range(strrange))
Worksheets("RisicoMatrix").Range(strrange) = Worksheets("RisicoMatrix").Range(strrange) & ", " & Worksheets("RisicoTabel").Cells(nRow, 1)
numbercount2 = Len(Range(strrange))
With ActiveCell.Characters(Start:=(numbercount + 1), Length:=(numbercount2 - numbercount)).Font
.ColorIndex = 1
End With

Else
Range(strrange).Select
Selection.Font.ColorIndex = 1
Worksheets("RisicoMatrix").Range(strrange) = Worksheets("RisicoTabel").Cells(nRow, 1)
End If

 

[fra]

Geplaatst door jakko1972
Indien de karakter al eerder daar stond krijgt het de kleur zwart.

Bedoel je daarmee dat - als bv. een 4 wordt toegevoegd en als in de voorgaande getallen het getal 4 reeds voorkwam - die tweede 4 zwart moet worden?

Geplaatst door jakko1972
Voorbeeld van waarden van een cel: 1, 2, 3, 4, 5
nu wil ik de cijfers 2 en 4 wit en de rest zwart.
Natuurlijk kan het in een ander voorbeeld 1, 3, 4 wit zijn.

Dat begrijp ik niet. Het cijfer 2 is wit, dus toegevoegd. Maar het cijfer 3 komt ná het cijfer 2 en is dus ook toegevoegd (idem met het cijfer 5). Waarom zijn de cijfers 3 en 5 dan toch zwart? Kortom: het criterium wanneer een cijfer wit of zwart moet zijn, is me niet duidelijk.

 

[jakko1972]

Extra toelichting

Fra,

Bedankt voor je reaktie, ik ben blijkbaar niet helemaal duidelijk geweest.
De cellen die worden gevuld door waarden die ergens anders staan. Het is voor een risicomatrix en de locatie is hierin van belang.
Wanneer een risico groter wordt verandert deze waarde en dus ook de locatie van deze risico. Dit betekend dat de risico (een nummer) naar een andere cel verhuisd. Het kan zijn dat er al andere risico's daar stonden. En wordt deze dus toegevoegd.

Voorbeeld.

Ik heb 5 risico's (nummers 1 t/m 8)

Huidige situatie
Risico 1, 5 en 8 zijn laag
Risico 2,3,4,6,7 zijn hoog
Allemaal zijn ze zwart

Nu verandert risico 3 en 7 van hoog naar laag

Nieuwe situate
Risico 1,3,5,7 en 8 (allen zwart)
Risico 2, 3(wit), 4, 6, 7(wit).

3 en 7 zijn nu wit de rest is zwart. Wit staat voor de oude situatie.

Omdat het programma regel voor regel kijkt wat de huidige en nieuwe waarde is wordt de matrix iedere keer opnieuw gevuld. Vandaar dat het kan dat risico 8 als laatste staat en zwart moet zijn.

Ik hoop dat het duidelijk is geworden en dat je me kan helpen.

Groetjes en alvast bedankt,

Jakko

 

[fra]

Onderstaande macro (hier toegepast op 1 cel) zorgt er voor dat wat toegevoegd wordt wit is en laat de kleur van wat er reeds in de cel stond onveranderd. Ik hoop dat het dat is wat je wil.

Sub Test()
Dim x As Integer, nrow As Integer, numbercount As Integer
Dim strrange As Range, clr() As Integer
numbercount = Len(Range("strrange"))
ReDim clr(numbercount)
With Range("strrange")
For x = 1 To numbercount
clr(x) = .Characters(Start:=x, Length:=1).Font.ColorIndex
Next x
.Value = .Value & ", " & Worksheets("Risicotabel").Cells(nrow, 1).Value
For x = 1 To Len(Range("strrange"))
If x <= numbercount Then
.Characters(Start:=x, Length:=1).Font.ColorIndex = clr(x)
Else
.Characters(Start:=x, Length:=1).Font.ColorIndex = 2
End If
Next x
End With
End Sub

fra

 

[jakko1972]

Bedankt

Fra, hoewel ik even goed moest lezen en begrijpen hoe je de oplossing gaf heb ik dankzij jou een werkend programma.

Erg bedankt voor je inzet en in snap VBA nu weer een beetje meer.

Gr,

Jakko