Wo ist der Fehler?Bedingte Formatierung: mehr als 3 Bedingungen in

22/02/2010 - 17:17 von Michael Karajan | Report spam
Hallo NG!

Ich habe eine Lösung für mein Problem (mehrere Berdingungen für Bedingtes
Formatieren). Bei Prüfung einer Spalte funktioniert der Code. JEdoch wenn ich
dann auch noch Spalte S prüfen will klappt es nicht. Irgendwie sitze ich auf
der Leitung. Kann mir jemqnd helfen?

Gruß Michael

Hier der Code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngCell As Range
Dim bytColor As Byte
Dim fntColor As Byte
Dim fntBld As Boolean

' Bereich der überwacht wird

Set Target = Intersect(Target, Range("r:r"))
If Target Is Nothing Then Exit Sub

' Hier wird Termin zum Datum geprüft

For Each rngCell In Target
Select Case rngCell.Value 'Wert in Großbuchstaben umwandeln
'Select Case rngCell.Date

Case Is = ""
bytColor = 0 ' keine Farbe
fntColor = 0
fntBold = False

Case Is > #12/31/2009#
bytColor = 31
fntColor = 2
fntBld = False

Case Is < #1/1/2010#
bytColor = 12
fntColor = 2



Case Else
bytColor = 0 ' keine Farbe
fntColor = 0
fntBold = False
End Select



Range(Cells(Target.Row, 1), Cells(Target.Row, 20)).Interior.ColorIndex =
bytColor 'Zeile A bis N
Range(Cells(Target.Row, 1), Cells(Target.Row, 20)).Font.ColorIndex = fntColor
Range(Cells(Target.Row, 1), Cells(Target.Row, 20)).Font.Bold = fntBld
Next rngCell

' Bereich der überwacht wird

Set Target = Intersect(Target, Range("s:s"))
If Target Is Nothing Then Exit Sub

' Hier wird Gespràch am Datum geprüft

For Each rngCell In Target
Select Case rngCell.Value 'Wert in Großbuchstaben umwandeln
'Select Case rngCell.Date

Case Is = ""
bytColor = 0 ' keine Farbe
fntColor = 0
fntBold = False

Case Is > #12/31/2009#
bytColor = 3
fntColor = 2
fntBld = True

Case Is < #1/1/2010#
bytColor = 4
fntColor = 2
fntBld = True


Case Else
bytColor = 0 ' keine Farbe
fntColor = 0
fntBold = False
End Select



Range(Cells(Target.Row, 1), Cells(Target.Row, 20)).Interior.ColorIndex =
bytColor 'Zeile A bis N
Range(Cells(Target.Row, 1), Cells(Target.Row, 20)).Font.ColorIndex = fntColor
Range(Cells(Target.Row, 1), Cells(Target.Row, 20)).Font.Bold = fntBld
Next rngCell


End Sub
 

Lesen sie die antworten

#1 Andreas Killer
22/02/2010 - 17:47 | Warnen spam
Michael Karajan schrieb:

Ich habe eine Lösung für mein Problem (mehrere Berdingungen für Bedingtes
Formatieren). Bei Prüfung einer Spalte funktioniert der Code. JEdoch wenn ich
dann auch noch Spalte S prüfen will klappt es nicht. Irgendwie sitze ich auf
der Leitung. Kann mir jemqnd helfen?


Schaun wir mal.

Private Sub Worksheet_Change(ByVal Target As Range)


...
Set Target = Intersect(Target, Range("r:r"))
If Target Is Nothing Then Exit Sub


Naja, da ist der Fehler ja schon. Wenn Du in Spalte S etwas ànderst,
dann verlàßt Du hier die Sub.

For Each rngCell In Target
Select Case rngCell.Value 'Wert in Großbuchstaben umwandeln


Hier ist nichts in Großbuchstaben zu wandeln, ein Datum ist eine Zahl.

Range(Cells(Target.Row, 1), Cells(Target.Row, 20)).Interior.ColorIndex =
bytColor 'Zeile A bis N


Das kann IMHO nicht richtig sein, denn Target.Row kann ja alles
mögliche sein. Müsste doch rngCell.Row heißen, oder?

Außerdem kann man das in eine WITH Anweisung packen.

Next rngCell


Sehr ordentlich, bringt nix außer 7 Bytes mehr Dateigröße. :-))

Set Target = Intersect(Target, Range("s:s"))


Hier kommt der gleiche Code wie oben!? Dann kann man auch das
zusammenfassen.

Ich hàng mal eine gekürzte Fassung an.

Andreas.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngCell As Range
Dim bytColor As Byte
Dim fntColor As Byte
Dim fntBld As Boolean

' Bereich der überwacht wird
Set Target = Intersect(Target, Range("r:r"), Range("S:S"))
If Target Is Nothing Then Exit Sub

' Hier wird Termin zum Datum geprüft
For Each rngCell In Target
Select Case rngCell.Value
Case Is = ""
bytColor = 0 ' keine Farbe
fntColor = 0
fntBold = False

Case Is > #12/31/2009#
bytColor = 31
fntColor = 2
fntBld = False

Case Is < #1/1/2010#
bytColor = 12
fntColor = 2

Case Else
bytColor = 0 ' keine Farbe
fntColor = 0
fntBold = False
End Select

'Zeile A bis N
With Range(Cells(rngCell.Row, 1), Cells(rngCell.Row, 20))
.Interior.ColorIndex = bytColor
.Font.ColorIndex = fntColor
.Font.Bold = fntBld
End With
Next
End Sub

Ähnliche fragen