Select Case gecombineerd met Left tekstvoorwaarde

Status
Niet open voor verdere reacties.
G

Geert929

Gebruiker
Lid geworden
28 okt 2006
Berichten
6
Om meervoudige voorwaardelijke opmaak te creêren ben ik al zover dat het lukt met numerieke waarden, en exacte strings.
Nu wil ik ook voorwaardelijke opmaak geven als de eerste twee letters voldoen aan een voorwaarde. Bvb; Als "GEEL" of "GEEN in de cel, dan geel kleuren.
Hieronder de code die ik nu heb in het VBA-werkblad.
Echter het werkt niet, alle lege cellen krjgen de kleur 6 (geel).
Cellen met "GEEL" erin kleuren niet.
Wat is er fout. Een ervaren VBA-er ziet het direct. Ik ben startend amateur....
------
Alvast hartelijk dank!
------
Code: 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim x As Range
    For Each x In ActiveSheet.Range("D5:I15")
    With x
    Select Case .Value
      Case Is < 0
          .Interior.ColorIndex = 38
      Case 1 To 5
          .Interior.ColorIndex = 3
      Case Is = Left("x", 2) = "GE"
          .Interior.ColorIndex = 6
      Case 11 To 15
          .Interior.ColorIndex = 1
      Case 16 To 20
          .Interior.ColorIndex = 5
      Case 21 To 25
          .Interior.ColorIndex = 4
      Case 26 To 30
          .Interior.ColorIndex = 45
      Case Else
          .Interior.ColorIndex = xlNone
    End Select

   End With
   Next

  End Sub
 
Laatst bewerkt:
Volgens mij maak je een verkeerd gebruik van de SELECT CASE.

Code: 
SELECT CASE x
   CASE 1
      Actie A
   CASE 2 To 4
      Actie B
   CASE > 4
      Actie C
END SELECT

Een eventueel IF statement definieer je dan als Actie.
 
Plaats eens code tags aub. Laat wel de apostrof twee keer weg. Dan wordt de code leesbaar.

Het is ook altijd goed om je code te laten inspringen, dan behoud je veel meer het overzicht.
 
Code: 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    Dim x As Range
    For Each x In ActiveSheet.Range("D5:I15")
        With x
            If Left(.Value, 2) = "GE" Then
                .Interior.ColorIndex = 6
            Else
                Select Case .Value
                    Case Is < 0
                        .Interior.ColorIndex = 38
                    Case 1 To 5
                        .Interior.ColorIndex = 3
                    Case 11 To 15
                        .Interior.ColorIndex = 1
                    Case 16 To 20
                        .Interior.ColorIndex = 5
                    Case 21 To 25
                        .Interior.ColorIndex = 4
                    Case 26 To 30
                        .Interior.ColorIndex = 45
                    Case Else
                        .Interior.ColorIndex = xlNone
                End Select
            End If
        End With
    Next

End Sub

Wigi
 
Select Case met verschillende beginstrings

Dank u wel voor de hulp.
Hetgeen ik vroeg werkt zo inderdaad prima.
Maar u raadt het al, het is nog niet geheel wat ik uiteindelijk wil...
Ik wil meerdere beginstrings naar specifieke voorwaardelijke opmaak laten leiden.
Bvb. beginletters "GE" => bvb. geel opvullen, "RO" => rood opvullen.
Daarbij ook nog eens al of niet hoofdlettergevoelig. (Goe bezig ;) )
Met de ontvangen hulp zal het me -toch deels- wel lukken via IF-functies na mekaar, maar het zou toch eleganter zijn om dit via Select Case te kunnen doen.
Ik start het wroeten....
Wie me wil helpen, of op weg wil zetten, be my guest....
 
Gewoon 2 Select Case structuren na elkaar.

De eerste keer voor

Select Case Left(.Value, 2)

de tweede keer voor

Select Case .Value (en die heb je al).

Doe met Exit Sub desgewenst het stoppen van de code nadat na eerste Select Case de opmaak werd toegepast.

Wigi
 
Yep, dat zie ik zitten

Jawel, dat zie ik zitten.
Ik zal straks trachten het verder uit werken, tot het voldoet en kan dienen als standaard.
Met die hoofdletters ben ik nog wel even zoet.
Misschien dat iemand anders er dan ook gebruik van kan maken...
Nogmaals hartelijk dank. :p
Het is(lijkt) zo eenvoudig en mooi als het uiteindelijk goed werkt, maar ... als je zo maar heel af en toe iets in elkaar tracht te knutselen is het verdorie toch soms taai om erdioor te raken. Vooral als je het maar half en half. kent.
Maar als het lukt maak ik het dus zeker wereldkond...
 
Op die hoofdletters zal je nog iets moeten vinden, idd.

Alvast veel leerplezier gewenst op de tocht... ;)

Wigi
 
Wigi zei:
Plaats eens code tags aub. Laat wel de apostrof twee keer weg. Dan wordt de code leesbaar.

Het is ook altijd goed om je code te laten inspringen, dan behoud je veel meer het overzicht.
Klik om te vergroten...

Doe dit ook nog eens, aub. Pas daarvoor je eerste post aan. Selecteer de VBA code, en klik op het hekje als opmaak.

Bedankt.
 
Op dit moment is dit de code:

Code: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

 Dim x As Range
    For Each x In ActiveSheet.Range("D5:I15")
        With x
        Select Case .Value
            Case Is < 0
                .Interior.ColorIndex = 1
            Case 1 To 5
                .Interior.ColorIndex = 2
            Case 11 To 15
                .Interior.ColorIndex = 4
            Case Else
                .Interior.ColorIndex = xlNone
            End Select
                
        Select Case Left(.Value, 2)
            Case Is = "GE"
                .Interior.ColorIndex = 6
            Case Is = "RO"
                .Interior.ColorIndex = 3
            Case Else
                .Interior.ColorIndex = xlNone
            End Select
        End With
    Next
  End Sub
Ik ben er nog niet, doch heb niet meer tijd. Wat ik zeker wil laten werken, werkt...:D
Heb in objectenoverzicht aan het zoeken geweest, iets met Caps of IgnoreCaps; maar zie nog niet de te volgen weg.
Waarop en waar exact ik de Exit Sub kan triggeren is me ook nog niet duidelijk.
Zal de "For Each...Next" dan ook niet worden afgebroken...?
Wat ik wel weet is dat het over twaalf is en ik er om 6 uit moet...om den brode.
Daarom laat ik het even rusten (input altijd welkom) en ga dat zelf ook doen....
Nogmaals dank, beste Wigi. Morgenavond kijk ik terug, en probeer ik anders nog wel even verder...
 
Ik heb nog wel wat overuren gedaan...

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim x As Range
    Dim iKleurtje
    For Each x In ActiveSheet.Range("D5:I15")
        With x
            Select Case .Value
            Case Is < 0: iKleurtje = 1
            Case 1 To 5: iKleurtje = 2
            Case 11 To 15: iKleurtje = 4
            End Select

            If UCase(Left(.Value, 2)) = Left(.Value, 2) Then
                'het zijn hoofdletters
                Select Case Left(.Value, 2)
                Case "GE": iKleurtje = 6
                Case "RO": iKleurtje = 3
                End Select
            Else
                'het zijn kleine letters
                Select Case Left(.Value, 2)
                Case "ge": iKleurtje = 16    'kies zelf
                Case "ro": iKleurtje = 13    'kies zelf
                End Select
            End If
        End With

        If iKleurtje Is Nothing Then iKleurtje = xlNone
        x.Interior.ColorIndex = iKleurtje

    Next
End Sub

ongeteste code

Wigi
 
Hoi,

Ik heb niet de hele topic doorgelezen, maar waarom kijken of het een hoofdletter of een kleine letters is voordat je een select case doet. Dit kan toch in de Case select zelf

Je kan toch gewoon:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim x As Range
    Dim iKleurtje As Long
    For Each x In ActiveSheet.Range("D5:I15")
        iKleurtje = xlNone
        With x
            Select Case .Value
            Case Is < 0: iKleurtje = 1
            Case 1 To 5: iKleurtje = 2
            Case 11 To 15: iKleurtje = 4
            End Select

            ' Hoofdletters of kleine letters
            Select Case Left(.Value, 2)
                Case "GE": iKleurtje = 6
                Case "RO": iKleurtje = 3
                Case "ge": iKleurtje = 16    'kies zelf
                Case "ro": iKleurtje = 13    'kies zelf
            End Select
        End With
        x.Interior.ColorIndex = iKleurtje

    Next
End Sub
 
Klopt Arno, ik zat wat in de knoop met het al dan niet Case sensitive zijn van Select Case. Bedankt om ons erop te wijzen.

Wigi
 
Met dank en waardering

Ja, als het er staat, begrijp ik het allemaal wel (of toch het meeste... na een tijdje...).
Ik heb er nog wat aan geprutst, en dit is mijn resultaat, om het hoofdletterongevoelig te maken. (Ik wil de opmaak hebben bij bvb. zowel "Geen" als "GEEL" als "gEvel" ....)
Het werkt zo prima, voor zover ik het heb getest, en voor hetgeen ik ervan gedaan wil hebben. Maar...er is nog een kleine maar...
Ik wou de twee eerste letters voor de tweemaal Select Case al afsplitsen en in LCase zetten, maar dan krijg ik telkens foutmelding. Logisch zeker, maar ik heb nog niet helemaal door waarom. Heb het dan disabled (met 2 x een apostrof ervoor) en het dan op de gewone, door jullie gebruikte wijze teruggezet en zo werkt het prima.
Dit is het dan.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

Dim xCel As Range
Dim iKleurtje As Single
Dim aTest As String
    
    For Each xCel In ActiveSheet.Range("D5:I15")
    iKleurtje = xlNone
    'aTest = LCase((Left(.Value, 2)))
        With xCel
            
            Select Case .Value
            Case Is < 0: iKleurtje = 1
            Case 1 To 5: iKleurtje = 2
            Case 11 To 15: iKleurtje = 4
            End Select

            Select Case LCase((Left(.Value, 2)))
            'Select Case aTest
            Case "12": iKleurtje = 6
            Case "ro": iKleurtje = 3
            End Select
            
        End With
    xCel.Interior.ColorIndex = iKleurtje
    Next
End Sub
U mag mij uiteraard informeren waarom juist die fout bij de alternatieve wijze.
Verder is mijn vraag zeker beantwoord, waarvoor ik u nogmaals dank.
(Plaats ik zelf deze vraag als beantwoord, of is dat voor de moderators?)
Dit is dan het lerend net zeker hé..
 
Zet

Code: 
With xCel

voor

Code: 
aTest = LCase((Left(.Value, 2)))

Want met .Value gebruik je al het feit dat je met With hebt afgekort.

Wigi
 
Geert929 zei:
(Plaats ik zelf deze vraag als beantwoord, of is dat voor de moderators?)
Dit is dan het lerend net zeker hé..
Klik om te vergroten...

Dat mag jij zelf doen. Klik onderaan op de pagina op de juiste status van de vraag.
 
Eerst begreep ik het toch niet te best.
Heb dan getest, als ik xCel toevoeg voor de .Value, dan werkt hetgeen ik had gemaakt ook in de eerste volgorde. Het lag aan mijn matige kennis van de instructie With...
Het was maar een fantasietje om wat, ja wat eigenlijk te doen..(de aTest was een fantasietje, de Sub zal echt zijn ding kunnen doen in de grote buitenwereld...)
Maar ik breek er dan toch een hele tijd mijn hoofd over waarom het niet werkt..
Dankjewel

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

Dim xCel As Range
Dim iKleurtje As Single
Dim aTest As String
    
    For Each xCel In ActiveSheet.Range("D5:I15")
    iKleurtje = xlNone
    aTest = LCase((Left(xCel.Value, 2)))
        With xCel
        'aTest = LCase((Left(.Value, 2)))
            Select Case .Value
            Case Is < 0: iKleurtje = 1
            Case 1 To 5: iKleurtje = 2
            Case 11 To 15: iKleurtje = 4
            End Select

            'Select Case LCase((Left(.Value, 2)))
            Select Case aTest
            Case "ge": iKleurtje = 6
            Case "ro": iKleurtje = 3
            End Select
            
        End With
    xCel.Interior.ColorIndex = iKleurtje
    Next
End Sub
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan