Voorwaardelijke opmaak

Teebee · 20 aug 2007

Hallo,

Hoe kan ik er voor zorgen dat de inhoud in kolom A,B,C,D eenzelfde kleur krijgen als in kolom A voldaan wordt aan een voorwaarde. Met 3 kleuren gaat het zonder VBA, maar er zijn een stuk of 20 waardes die in kolom A kunnen geplaatst worden.

voorbeeld:

Code:

Kolom A    Kolom B   Kolom C     Kolom D
 [COLOR="Red"]   100             12           Audi         25000[/COLOR]
[COLOR="Red"]    101             16           Audi         26000[/COLOR]
[COLOR="Blue"]    200             32           Bmw        35000[/COLOR]

Indien A1 > 100 < 200, dat dan alle 4 de waardes in die rij rood kleuren, en indien A1 > 200 < 300, dat dan alle 4 de waardes in die rij Blauw worden?

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
   
   With Target
   
    Select Case .Value
      Case 100 To 199
          .Interior.ColorIndex = 3
      Case 200 To 299
          .Interior.ColorIndex = 6
      Case 300 To 399
          .Interior.ColorIndex = 1
      Case 400 To 599
          .Interior.ColorIndex = 5
      Case 600 To 700
          .Interior.ColorIndex = 4
      Case Else
          .Interior.ColorIndex = xlNone
    End Select

   End With
   
  End Sub

Deze werkt enkel op de waarde die ik ingeef in kolom A, maar heb geen idee hoe ik dit uitbreidt naar de andere 3 kolommen.

Teebee · 20 aug 2007

Gevonden:

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
   
   With Target
   
    Select Case .Value
      Case 100 To 199
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = 6
      Case 200 To 299
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = 35
      Case 300 To 399
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = 38
      Case 400 To 599
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = 37
      Case 600 To 700
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = 3
      Case Else
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = xlNone
    End Select

   End With
   

  End Sub

Wigi · 20 aug 2007

Een stukje korter:

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
   
   With Target.Resize(1, 5).Interior
   
    Select Case .Value
      Case 100 To 199: .ColorIndex = 6
      Case 200 To 299: .ColorIndex = 35
      Case 300 To 399: .ColorIndex = 38
      Case 400 To 599: .ColorIndex = 37
      Case 600 To 700: .ColorIndex = 3
      Case Else: .ColorIndex = xlNone
    End Select

   End With
End Sub

Teebee · 20 aug 2007

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
   
   If Not Intersect(Target, Range("$A:$A")) Is Nothing Then
  
With Target
   
    Select Case .Value
      Case 100 To 199
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = 6
      Case 200 To 299
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = 35
      Case 300 To 399
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = 38
      Case 400 To 599
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = 37
      Case 600 To 700
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = 3
      Case Else
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = xlNone
    End Select

   End With
   
End If
  End Sub

Als ik jouw code gebruik krijg ik een error bij Select Case .Value
Is dat omdat ik de range $A toegevoegd heb misschien?

error:
Fout 438 tijdens uitvoering:
Deze eigenschap of methode wordt niet ondersteund door dit object.

Wigi · 20 aug 2007

Teebee zei:
Als ik jouw code gebruik krijg ik een error bij Select Case .Value

Welke code gebruik je nu?

Teebee · 20 aug 2007

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
   
   If Not Intersect(Target, Range("$A:$A")) Is Nothing Then
  
With Target
   
    Select Case .Value
      Case 100 To 199
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = 6
      Case 200 To 299
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = 35
      Case 300 To 399
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = 38
      Case 400 To 599
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = 37
      Case 600 To 700
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = 3
      Case Else
            .Offset(0, 0).Resize(1, 5).Interior.ColorIndex = xlNone
    End Select

   End With
   
End If
  End Sub

Wigi · 20 aug 2007

Code:

  If Not Intersect(Target, Range("A:A")) Is Nothing Then

Teebee · 20 aug 2007

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
   
 If Not Intersect(Target, Range("A:A")) Is Nothing Then
  
   With Target.Resize(1, 5).Interior
   
    Select Case .Value
      Case 100 To 199: .ColorIndex = 6
      Case 200 To 299: .ColorIndex = 35
      Case 300 To 399: .ColorIndex = 38
      Case 400 To 599: .ColorIndex = 37
      Case 600 To 700: .ColorIndex = 3
      Case Else: .ColorIndex = xlNone
    End Select

   End With
   
End If
  End Sub

Als ik dit gebruik krijg ik die error 348, dus gebruik ik de iets minder kleine code voorlopig.

Wigi · 20 aug 2007

Sorry, de With stond op een verkeerde plaats:

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    If Not Intersect(Target, Range("A:A")) Is Nothing Then

        Select Case Target.Value
            
            With Target.Resize(1, 5).Interior
                Case 100 To 199: .ColorIndex = 6
                Case 200 To 299: .ColorIndex = 35
                Case 300 To 399: .ColorIndex = 38
                Case 400 To 599: .ColorIndex = 37
                Case 600 To 700: .ColorIndex = 3
                Case Else: .ColorIndex = xlNone
            End With
        End Select
    End If
End Sub

Wigi

Teebee · 20 aug 2007

nu krijg ik de volgende error:

Compileerfout:
Instructies en namen zijn ongeldig tussen Select Case en de eerste Case

Wigi · 20 aug 2007

Amai, slechte dag precies vandaag...

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    If Not Intersect(Target, Range("A:A")) Is Nothing Then
    
        With Target.Resize(1, 5).Interior
        
            Select Case Target.Value
            
                Case 100 To 199: .ColorIndex = 6
                Case 200 To 299: .ColorIndex = 35
                Case 300 To 399: .ColorIndex = 38
                Case 400 To 599: .ColorIndex = 37
                Case 600 To 700: .ColorIndex = 3
                Case Else: .ColorIndex = xlNone
                
            End Select
        
        End With
    End If
End Sub

Dit heb ik wel getest.

Wigi

Teebee · 20 aug 2007

:thumb:

Mijn slechte dag moet nog beginnen, heb nl. nachtpost.

Teebee · 5 nov 2007

Kan me iemand nog eens op de goeieweg helpen ?

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
  
       With Target.Resize(1, 2).Interior
        
            Select Case Target.Value
                Case 0.01 To 20: .ColorIndex = 3
                Case 20 To 24.99: .ColorIndex = 45
                Case 25 To 29.99: .ColorIndex = 4
                Case 30 To 100: .ColorIndex = 3
                Case Else: .ColorIndex = xlNone
                
            End Select
        
        End With
    End If
End Sub

Ik heb 5 voorwaardes, maar telkens ik iets probeer loopt er altijd wel iets mis

Voorwaardes:
1 Getal kleiner dan 20 : rood
2 Getal > 20 en < 25 : oranje
3 Getal > 25 en < 30 : groen
4 Getal > 30 : oranje
5 niets ingevuld, ingekleurde cel moet terug naar standardkleur gaan, nl wit (xlnone)

Code:

Case Is < 20 > 0: .ColorIndex = 3
Case Is <= 25 > 20: .ColorIndex = 45
Case Is <= 30 > 25: .ColorIndex = 4
Case Is > 30: .ColorIndex = 45
Case Else: .ColorIndex = xlNone

Dit had ik ook geprobeerd maar was ook niet correct.

Wigi · 5 nov 2007

Code:

Case 0 To 20: .ColorIndex = 3
Case 21 To 25: .ColorIndex = 45
Case 26 To 30: .ColorIndex = 4
Case Is > 30: .ColorIndex = 45
Case Else: .ColorIndex = xlNone

Teebee · 5 nov 2007

Probleem hiermee is dat 25 nu oranje kleurt, en 25 zou groen moeten zijn, en als ik het getal verwijder dat de cellen roodkleuren ipv xlnone.

Vergeten te vermelden dat het tot 2 cijfers na de comma werkt.

Wigi · 5 nov 2007

Zo dan?

Code:

Case 0 To 20: .ColorIndex = 3
Case 21 To 24,99: .ColorIndex = 45
Case 25 To 30: .ColorIndex = 4
Case Is > 30: .ColorIndex = 45
Case Else: .ColorIndex = 3

Teebee · 5 nov 2007

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    If Not Intersect(Target, Range("A:A")) Is Nothing Then
    
        With Target.Resize(1, 2).Interior
        
            Select Case Target.Value
            
Case 0 To 19.99: .ColorIndex = 3
Case 20 To 24.99: .ColorIndex = 45
Case 25 To 30: .ColorIndex = 4
Case Is > 30: .ColorIndex = 45
Case Else: .ColorIndex = xlNone
                
            End Select
        
        End With
    End If
End Sub

Nu heb ik nog steeds het probleem als ik de cijfers terug verwijder dat de cellen rood/worden ipv dat de kleuren terug verwijdert worden.

edit: Indien ik Case 0.01 to 19.99 gebruikt werkt het wel.
Bestaat er niet zoiets als > 0 & < 20 ?

Wigi · 5 nov 2007

Teebee zei:
edit: Indien ik Case 0.01 to 19.99 gebruikt werkt het wel.

Dat is idd wat je moet doen, want bvb

Code:

Case Is > 0, Is <= 19.99: .ColorIndex = 3

dan kleurt het rood aangezien 0 <= 19.99

Teebee · 5 nov 2007

Kan ik hier nu ook nog een .Offset(1, 0).ColorIndex = 3 op toepassen zodat de cel naast het getal verkleurt en niet het getal zelf , dus in kolom B?

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    If Not Intersect(Target, Range("A:A")) Is Nothing Then
    
        With Target.Offset(0, 1).Interior
        
            Select Case Target.Value
            
Case 0.01 To 19.99: .ColorIndex = 3
Case 20 To 24.99: .ColorIndex = 45
Case 25 To 30: .ColorIndex = 4
Case Is > 30: .ColorIndex = 45
Case Else: .ColorIndex = xlNone
                
            End Select
        
        End With
    End If
End Sub

Dit zou misschien kunnen werken dus, of is er een betere methode ?
Kan zijn dat zowel A en B dezelfde kleur moeten hebben., en dan is voorgaande reply goed genoeg

Wigi · 5 nov 2007

Code:

 With Target.Resize(1, 2).Interior

wordt

Code:

 With Target.Offset(0, 1).Interior

Voorwaardelijke opmaak

Gebruiker

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Wij waarderen jouw privacy