• 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.

cel in keuren op basis van verschillende waarden

Status
Niet open voor verdere reacties.
S

spa123

Gebruiker
Lid geworden
3 jun 2015
Berichten
26
Is het mogelijk een cel in te kleuren op basis van cel waarde?

Ik doe dit nu op basis van voorwaardelijke opmaak in combinatie met een formule.
Heel omslachtig hoe dit nu is ingesteld en lastig uit te breiden als ik meer kleuren wil.

Ik doe het momenteel zo:

Als er in kolom B een "V" ingevuld staat doe dan niets.
Als er in kolom B een "B" ingevuld staat, kijk dan naar het crediteur nummer bijvoorbeeld kolom Y.
En geef iedere crediteur zijn eigen kleur.

Ik heb nu een tabel gemaakt met crediteur nummers met daar achter de kleur getypt
1600 "blauw"
1602 "rood"

Als ik in kolom B, de letter "B" getypt staat wordt er via vert.zoeken gezocht naar de kleur en erachter gezet in kolom Z
Kolom B heeft een voorwaardelijke opmaak en kijkt naar de waarden in kolom Z bijvoorbeeld blauw.
En als er dus blauw staat wordt deze cel blauw.


Zoals je leest heel omslachtig dus, dit moet makkelijker kunnen toch?
 
Het hang er vanaf hoeveel mogelijke crediteur nummers je hebt. Wanneer dit er iig al meer dan 10 worden, zou ik gek worden van de 10 formules die je moet maken in de voorwaardelijke opmaak. Dan zou je over moeten stappen op VBA, maar VBA is een beetje ***** i.c.m. voorwaardelijke opmaak.

Verder heb je eventueel ook geen hulpkolom nodig en kan je enkel al op basis van het crediteurnummer en combinatie met kolom B al de kleur bepalen. Mits het natuurlijk niet teveel mogelijkheden brengt zoals m'n eerste zin.

Mochten er niet te veel crediteuren zijn zou je een formule kunnen gebruiken:
Code: 
=EN(B2="B";vert.zoeken(Y2;[I]crediteurenbereik[/I];2;onwaar)="Blauw")
Deze formule kan je dus gebruiken voor blauwe crediteur combinaties. Je houd wel een tabel met je crediteuren en bijhorende kleuren.
 
Ja precies!
Zoals jij het nu ongeveer omschrijft heb ik het momenteel ingericht.
En ik wordt er inderdaad gek van om alles in een voorwaardelijke opmaak te onderhouden en soms andere toe te voegen.

Is zo'n VBA heel moeilijk?
Iemand hier die misschien een voorzetje kan doen wat ik zelf kan uitbreiden?
 
Kan je even een bestandje uploaden met wat je nu hebt?
 
is goed! Hierbij.
Bekijk bijlage kleur per crediteur.xlsx

Dit is hoe ik het nu heb en dus bedacht had.
Het werkt goed hoor maar ik vind het met die voorwaardelijke opmaak te omslachtig om iets toe te voegen.

Ik denk dit moet misschien makkelijke kunnen met VBA oid?
 
Cobbe zei:
Zou dit het hem doen?
Klik om te vergroten...

ja perfect dit werkt handig!
Alleen 1 nadeel, de kleuren werken pas na 1 keer iets aanpassen in kolom F.
Is dat nog te omzijlen zodat deze trigger niet meer nodig is?
 
Zet deze dan in een module en hang er een button aan:

Code: 
Sub kleuren()
  For Each cl In ActiveSheet.Range("F6:F20")
   cl.Offset(, -5).Interior.ColorIndex = Sheets("Blad2").Range("A:A").Find(cl).Offset(, 1).Interior.ColorIndex
  Next
End Sub
 
bedankt! valt dit nog op te nemen dat dit automatisch uitgevoerd wordt voor afdrukken ofzo?
 
Laat eens weten wat je eigenlijk wil vragen want ik begrijp het niet. :)
 
en hij loopt vast als er een crediteur nummer ingevuld wordt welke niet op tablad 2 vernoemd staat met kleur.
Als er geen kleur aangehangen is zou er eigenlijk niets moeten gebeuren.
 
Cobbe zei:
Laat eens weten wat je eigenlijk wil vragen want ik begrijp het niet. :)
Klik om te vergroten...

Automatisch de kleur aanpassen bij het veranderen van een B naar een V of andersom.
Nu gebeurd er pas iets als je het crediteur nummer aanpast.
Zou dus handig zijn als bij het aanpassen van B naar V er iets gebeurd.

En als ik een B of V invul en er staat een crediteurnummer achter welke niet op blad 2 met kleur voorkomt hoeft er niets te gebeuren.
 
Test dan deze eens :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
 On Error GoTo Oeps
 If Not Intersect(Target, Range("B6:B20")) Is Nothing Then
  For Each cl In Range("B6:B20")
   cl.Offset(, -1).Interior.ColorIndex = Sheets("Blad2").Range("A:A").Find(cl.Offset(, 4)).Offset(, 1).Interior.ColorIndex
  Next
 End If
Oeps:
End Sub
 
Cobbe zei:
Test dan deze eens :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
 On Error GoTo Oeps
 If Not Intersect(Target, Range("B6:B20")) Is Nothing Then
  For Each cl In Range("B6:B20")
   cl.Offset(, -1).Interior.ColorIndex = Sheets("Blad2").Range("A:A").Find(cl.Offset(, 4)).Offset(, 1).Interior.ColorIndex
  Next
 End If
Oeps:
End Sub
Klik om te vergroten...

helaas deze werkt helemaal niet, 1x bij aanpassen b naar v daarna niet meer.
Indien je van de v weer een b maakt.
probeer maar in het documentje wat je gemaakt hebt.
 
Laatst bewerkt:
Ja maar wat moet er wanneer gebeuren, ik kan niet weten wat jij denkt dat er moet gebeuren.

De code reageert nu enkel op een wijziging in bereik(B6:B20),
en niet op een wijziging van b naar v of andersom.
Wat moet er gebeuren als een b wordt ingegeven en wat als er een v wordt ingegeven?

Deze aanpassing zorgt ervoor dat hij reageert op b en/of v:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
 On Error GoTo Oeps
 If Not Intersect(Target, Range("B6:B20")) Is Nothing Then
  For Each cl In Range("B6:B20")
   cl.Offset(, -1).Interior.ColorIndex = xlNone
   If UCase(cl) = "B" Then
    cl.Offset(, -1).Interior.ColorIndex = Sheets("Blad2").Range("A:A").Find(cl.Offset(, 4)).Offset(, 1).Interior.ColorIndex
   End If
  Next
 End If
Oeps:
End Sub
 
Laatst bewerkt:
Cobbe zei:
Ja maar wat moet er wanneer gebeuren, ik kan niet weten wat jij denkt dat er moet gebeuren.

De code reageert nu enkel op een wijziging in bereik(B6:B20),
en niet op een wijziging van b naar v of andersom.
Wat moet er gebeuren als een b wordt ingegeven en wat als er een v wordt ingegeven?
Klik om te vergroten...

sorry:D

Ik zal het iets duidelijker uitleggen:
Dit is een complete lijst welke uiteraard een stuk langer is als het voorbeeld.
Aan de hand van vert.zoeken via de waarde in kolom A, worden automatisch kolom D, E en F ingevuld.
Maar dit werkt al hoeft dus niet aangepast te worden.
Kolom B lopen we hier na aan de hand van onze voorraad om te kijken wat er eventueel besteld moet worden of waar we zelf voldoende van op voorraad hebben.
Vandaar de "B"= bestellen of "V"= is voorraad.
Als de waarde in kolom B aangepast wordt en hier dus een letter "B" van gemaakt wordt wil ik dat het artikel nummer een kleur krijgt.
Deze kleur moet dan gerelateerd zijn aan de toegekende crediteur kleur.
Zodat als ik de lijst print alles wat een "B" heeft de artikelnummer per crediteur dezelfde kleur hebben zodat je makkelijk aan de hand van de kleur ziet wat waar te bestellen.

Als er een "V" staat in kolom B dus geen kleur.
En als er een crediteur geen kleur toegekend heeft gekregen op tabblad 2 hoeft er ook niets te gebeuren.
 
Dan moet deze aangepaste code toch wel voldoen:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
 On Error GoTo Oeps
 
  For Each cl In Range("B6:B20")
   cl.Offset(, -1).Interior.ColorIndex = xlNone
   If UCase(cl) = "B" Then
    cl.Offset(, -1).Interior.ColorIndex = Sheets("Blad2").Range("A:A").Find(cl.Offset(, 4)).Offset(, 1).Interior.ColorIndex
   End If
  Next
 
Oeps:
End Sub
 
Cobbe zei:
Dan moet deze aangepaste code toch wel voldoen:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
 On Error GoTo Oeps
 
  For Each cl In Range("B6:B20")
   cl.Offset(, -1).Interior.ColorIndex = xlNone
   If UCase(cl) = "B" Then
    cl.Offset(, -1).Interior.ColorIndex = Sheets("Blad2").Range("A:A").Find(cl.Offset(, 4)).Offset(, 1).Interior.ColorIndex
   End If
  Next
 
Oeps:
End Sub
Klik om te vergroten...

bijna!

Want als ik nu bij crediteur nummer 6 invul pakt tie ook de kleur van 1600
En als ik nummer 9 invul pakt tie het de kleur van 1900.

terwijl er dan eigenlijk niets moet gebeuren aangezien 6 en 9 geen kleur hebben.
 
Ja soms vergeet je al eens iets:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
 On Error GoTo Oeps
 
  For Each cl In Range("B6:B20")
   cl.Offset(, -1).Interior.ColorIndex = xlNone
   If UCase(cl) = "B" Then
    Set c = Sheets("Blad2").Range("A:A").Find(cl.Offset(, 4), LookIn:=xlValues, lookat:=xlWhole)
     If Not c Is Nothing Then
      cl.Offset(, -1).Interior.ColorIndex = Sheets("Blad2").Range("A:A").Find(cl.Offset(, 4)).Offset(, 1).Interior.ColorIndex
     End If
   End If
  Next
Oeps:
End Sub
 
Cobbe zei:
Ja soms vergeet je al eens iets:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
 On Error GoTo Oeps
 
  For Each cl In Range("B6:B20")
   cl.Offset(, -1).Interior.ColorIndex = xlNone
   If UCase(cl) = "B" Then
    Set c = Sheets("Blad2").Range("A:A").Find(cl.Offset(, 4), LookIn:=xlValues, lookat:=xlWhole)
     If Not c Is Nothing Then
      cl.Offset(, -1).Interior.ColorIndex = Sheets("Blad2").Range("A:A").Find(cl.Offset(, 4)).Offset(, 1).Interior.ColorIndex
     End If
   End If
  Next
Oeps:
End Sub
Klik om te vergroten...

bedankt werkt top!
weet jij alleen hoe het kan dat de kleuren niet exact hetzelfde zijn?
zie screenshots:
kleuren blad1.PNG
kleuren blad2.PNG
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan