simpele vba-code voor 'voorwaardelijke opmaak' gezocht

[jajajajanneke]

Hoi,

Ik ben op zoek naar een simpele code zie in een bepaalde cel kijkt of hetgeen wat ingevoerd is begint met een 4 en aan de hand daarvan andere cellen (in het zelfde tabblad) een kleur geeft.

Ik kwam tot nu toe met dit, maar dat werkt niet:

[COLOR="#0000CD"]Private Sub Worksheet_Change(ByVal Target As Range)

If Range("B6") Like "4*" Then
Range("I6:K6").Interior.ColorIndex = 15
End If

End Sub[/COLOR]

Weet iemand een simpele oplossing die wel werkt?

Alvast bedankt.

Groetjes,
Janneke

 

[wampier]

mogelijk:

if left(range("b6".value),1) = 4 then

 

[enijhuis]

Hoi Janneke,

Ik vraag me werkelijk af waarom je dit niet gewoon met voorwaardelijke opmaak wilt oplossen.
Jouw code werkte trouwens gewoon bij mij.
Indien je het via VBA wilt doen dan onderstaande code gebruiken:

Private Sub Worksheet_Change(ByVal Target As Range)

    Const CHECKED_CELL = "$B$6"
    Const COLOR_GREY = 15
    Const COLOR_NONE = -4142
    
    'Check mbt performance: dient code te worden uitgevoerd?
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Address <> CHECKED_CELL Then Exit Sub
    
    On Error GoTo ErrHandler
    
    'Voorkom evt. endless loop
    Application.EnableEvents = False
    
    'Bepaal achtergrondkleur
    Range("I6:K6").Interior.ColorIndex = IIf(Left(Range(CHECKED_CELL), 1) = "4", COLOR_GREY, COLOR_NONE)

ErrHandler:
    Application.EnableEvents = True
End Sub

 

[jajajajanneke]

Thanx, ik ga er mee stoeien (al is de oplossing van enijhuis wel heel arg abracadabra voor mij).

Trouwens, de reden dat ik dit niet in in de normale voorwaardelijke opmaak doe is... hou je lachen in... dat wij op het werk nog met office 2003 werken! (dus maar 3 opmaak-mogelijkheden)..

 

[enijhuis]

Hoi Janneke,
Hmm. Als je dit al abracadabra vindt moet je je afvragen of je het wel via vb wilt oplossen.

Ik heb de code wat versimpeld en heb meer commentaar toegevoegd:

Private Sub Worksheet_Change(ByVal Target As Range)

    'Constanten (i.v.m. leesbaarheid/onderhoudbaarheid van de code)
    Const CHECKED_CELL = "$B$6"
    Const COLOR_BLACK = 1
    Const COLOR_WHITE = 2
    Const COLOR_RED = 3
    Const COLOR_GREEN = 4
    Const COLOR_BLUE = 5
    Const COLOR_YELLOW = 6
    Const COLOR_GREY = 15
    Const COLOR_NONE = -4142
    
    Dim sWaarde As String
    Dim rDoel As Range
    
    'Checks mbt performance: dient de code te worden uitgevoerd?
    'Check eerst of er maar 1 cel tegelijkertijd wordt gewijzigd
    If Target.Cells.Count > 1 Then Exit Sub
    'Check vervolgens of de gewijzigde cell gelijk is aan b6
    If Target.Address <> CHECKED_CELL Then Exit Sub
    
    'Checks OK. Schakel foutafhandeling in
    
    On Error GoTo ErrHandler
    
    'Voorkom evt. endless loop door tab-events in deze event-routine uit te zetten
    Application.EnableEvents = False

    'Bepaal achtergrondkleur o.b.v. bijvoorbeeld eerste karakter in cel CHECKED_CELL
    sWaarde = Left(Range(CHECKED_CELL), 1)
    
    With Range("I6:K6").Interior
    
        Select Case sWaarde
        
            Case "1"
                .ColorIndex = COLOR_BLACK
            Case "2"
                .ColorIndex = COLOR_WHITE
            Case "3"
                .ColorIndex = COLOR_RED
            Case "4"
                .ColorIndex = COLOR_GREEN
            Case "5"
                .ColorIndex = COLOR_BLUE
            Case "6"
                .ColorIndex = COLOR_YELLOW
            Case "7"
                .ColorIndex = COLOR_GREY
            Case Else
                'Overige gevallen
                .ColorIndex = COLOR_NONE
        
        End Select
        
    End With

ErrHandler:
    'Herstel Excel-events (Worksheet_Change)
    Application.EnableEvents = True
    'Is er een fout opgetreden?
    If Err.Number <> 0 Then
        MsgBox "Onverwachte fout: " & vbCr & Err.Description, vbExclamation
    End If
End Sub

Succes ermee!

Emiel