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

Excel voorwaardelijke opmaak op basis van lijst

Status
Niet open voor verdere reacties.
B

bomseler

Gebruiker
Lid geworden
31 aug 2016
Berichten
53
Beste Forumgebruikers,

Ik ben iets aan het uitproberen op basis van voorwaardelijke opmaak. Nu loop ik tegen een paar dingen aan:

1. Ik kan geen dikgedrukte rand toepassen met voorwaardelijke opmaak;
2. Ik wil per 3 rijen een rand maken en niet elke cel afzonderlijk omtrekken;
3. Is er een mogelijkheid om de opmaak vanuit de lijst te genereren? Dus niet in hoeven stellen via vw opmaak? Of moet ik het dan andersom doen, dat de lijst ook opgemaakt wordt door dezelfde vw opmaak, dat kan wel namelijk.
4. Is er een mogelijkheid om vw opmaak regels te kopiëren zodat ik alleen het bereik aan hoef te passen? Of moet ik dan al snel met VBA gaan werken?

Onderstaand het voorbeeld bestandje. (de opmaak met meer randen en patroon heb ik middels vw opmaak gedaan, de onderste regels is hoe het moet worden).

Bekijk bijlage Voorbeeld_VW-opmaak.xlsx

Alvast bedankt.
 
voorwaardelijke opmaak werkt volgens mij alleen per cel, je zou dan voor elke cel een aparte opmaak moeten maken.
bovenste met dikke rand boven en links en rechts, middelste alleen links en rechts, onderste links rechts en onder.

Of eerste de 3 cellen samenvoegen.
 
met VBA kom ik hierop:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Select Case Target.Value
        Case "A"
            Kleur = vbYellow
        Case "B"
            Kleur = vbBlue
        Case "C"
            Kleur = vbRed
    End Select
    
If Cells(Target.Row, 2).Value = "test1" Then
    With Target.Resize(3, 1)
        .Interior.Color = Kleur
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThick
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThick
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThick
            End With
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThick
            End With
    End With
End If
End Sub
 
Hierbij nog de variant met Voorwaardelijke Opmaak. Met dunne randen, want dikke randen zitten niet in het opmaakpalet bij VO.
 

Bijlagen

Laatst bewerkt:
SjonR zei:
met VBA kom ik hierop:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Select Case Target.Value
        Case "A"
            Kleur = vbYellow
        Case "B"
            Kleur = vbBlue
        Case "C"
            Kleur = vbRed
    End Select
    
If Cells(Target.Row, 2).Value = "test1" Then
    With Target.Resize(3, 1)
        .Interior.Color = Kleur
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThick
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThick
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThick
            End With
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThick
            End With
    End With
End If
End Sub
Klik om te vergroten...

Bedankt. Dit werkt inderdaad, er is nog een probleem. Voor alle andere waarden die ingevuld worden wordt het hele vak zwart en ook als je de waarde weer weghaald wordt het vak zwart.
Ik heb al bijvoorbeeld "Case " Kleur = vbNone geprobeerd maar dat werkte ook niet, dit zou overigens ook niet werken voor een waarde dit anders is als A/B/C.

Kan je mij hiermee op weg helpen?

Alvast bedankt.
 
ja, dat kon beter:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Select Case Target.Value
        Case "A"
            kleur = vbYellow
        Case "B"
            kleur = vbBlue
        Case "C"
            kleur = vbRed
        Case Else
        kleur = xlNone
            With Target.Resize(3, 1)
                .Interior.Color = kleur
                .Borders.LineStyle = xlLineStyleNone
            End With
    End Select

If Cells(Target.Row, 2) = "test1" And Target.Value = "A" Or Target.Value = "B" Or Target.Value = "C" Then
  
  With Target.Resize(3, 1)
        .Interior.Color = kleur
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThick
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThick
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThick
            End With
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThick
            End With
    End With
End If
End Sub

test deze eens!
 
Laatst bewerkt:
SjonR zei:
ja, dat kon beter:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Select Case Target.Value
        Case "A"
            kleur = vbYellow
        Case "B"
            kleur = vbBlue
        Case "C"
            kleur = vbRed
        Case Else
        kleur = xlNone
            With Target.Resize(3, 1)
                .Interior.Color = kleur
                .Borders.LineStyle = xlLineStyleNone
            End With
    End Select

If Cells(Target.Row, 2) = "test1" And Target.Value = "A" Or Target.Value = "B" Or Target.Value = "C" Then
  
  With Target.Resize(3, 1)
        .Interior.Color = kleur
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThick
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThick
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThick
            End With
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThick
            End With
    End With
End If
End Sub

test deze eens!
Klik om te vergroten...


Super, dit is precies wat ik zoek. Hartelijk bedankt!
 
@SjonR,

VBA kent ook de methode BorderAround. Scheelt wat tikwerk.;)

Code: 
With Target.Resize(3, 1)
    .Interior.Color = kleur
    .BorderAround xlContinuous, xlThick
  End With
 
ik had nog lopen zoeken, want vond het al vaag dat ik het per lijntje moest instellen, maar gelukkig heb ik jou nog! Thanks :thumb:
 
Hallo,

Toch nog een klein probleempje. Ik wil de vakjes (als ze eenmaal gemaakt zijn) ook kunnen verslepen.
Als ik dat nu doe dan krijg ik een foutmelding. Iemand een idee?

Zie vb bestandje.
 

Bijlagen

Het quoten is niet nodig. Klik op de knop 'Reageer op bericht' of 'snel reageren'.

De foutmelding komt omdat je target.count > 1 is. Dit zal je dus moeten ondervangen. De hele code kan wat korter maar minder begrijpelijk en nog korter.
Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count <> 1 Then Exit Sub
  c00 = Application.Choose(Asc(IIf(Target <> "", Target, 0)) - 64, vbYellow, vbCyan, vbRed)
  If Cells(Target.Row, 2) = "test1" Then
    With Target.Resize(3, 1)
      If IsError(c00) Then
        .Interior.Color = xlNone
        .Borders.LineStyle = xlLineStyleNone
       Else
        .Interior.Color = c00
        .BorderAround xlContinuous, xlThick
      End If
    End With
  End If
End Sub
 
Laatst bewerkt:
VenA bedankt.

Dit werkt inderdaad wel met het verplaatsen, maar nu blijven de vakjes ook staan als ik de letter weer delete.

Ik snap nu inderdaad de code ook niet meer. Deze is nu gemaakt op basis van het alfabet of niet? De letters zijn namelijk als voorbeeld bedoeld en daar wil ik eigenlijk een andere tekst voor in de plaats kunnen zetten.

Vandaar ook de lijst ernaast. Eigenlijk zou ik daarin A/B/C (D/E/etc.) moeten kunnen zetten die dan een bepaalde opmaak krijgen. Of is dit een heel lastig verhaal?
 
Dan kan je toch gewoon de code blijven gebruiken die je al had met als toevoeging
Code: 
If Target.Count <> 1 Then Exit Sub
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan