Zellen formatieren

[Crazy Tom]

Hallo Leute

XL2003 und XL2007

mit diesem Code formatiere ich Zellen nach ihrem Inhalt

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngBereich As Range, rngZelle As Range
    Set rngBereich = [C14:G40]
    For Each rngZelle In Range(Target.Address)
        If Not Intersect(rngZelle, rngBereich) Is Nothing Then
            With rngZelle
                Select Case UCase(.Value)
                    Case Is < 14, "TEST"
                        .Interior.ColorIndex = 3
                    Case Is > 50
                        .Interior.ColorIndex = 5
                    Case 14 To 21
                        .Interior.ColorIndex = 6
                    Case Else
                        .Interior.ColorIndex = xlNone
                End Select
            End With
        End If
    Next rngZelle
    Set rngBereich = Nothing
End Sub

bei allen Eingaben die eine Zahl sind oder das Wort "Test" funktioniert es
aber bei jeder anderen Buchstabenkombination nimmt er immer die
Formatierung von Case Is > 50
wie kann man das abfangen?

MfG Tom

[Steffl]

Hallo Tom,

versuchs mal so

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngBereich As Range, rngZelle As Range
    Set rngBereich = [C14:G40]
    For Each rngZelle In Range(Target.Address)
        If Not Intersect(rngZelle, rngBereich) Is Nothing Then
            With rngZelle
                If UCase(.Value) = "TEST" Then
                    .Interior.ColorIndex = 3
                ElseIf IsNumeric(.Value) Then
                    Select Case UCase(.Value)
                        Case Is < 14
                            .Interior.ColorIndex = 3
                        Case Is > 50
                            .Interior.ColorIndex = 5
                        Case 14 To 21
                            .Interior.ColorIndex = 6
                        Case Else
                            .Interior.ColorIndex = xlNone
                End Select
                End If
            End With
        End If
    Next rngZelle
    Set rngBereich = Nothing
End Sub

[Hajo_Zi]

Hallo Tom,

ich hätte bei Zahlen auch nur Zahlen verglichen.

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngBereich As Range, rngZelle As Range
    Set rngBereich = [C14:G40]
    For Each rngZelle In Range(Target.Address)
        If Not Intersect(rngZelle, rngBereich) Is Nothing Then
            With rngZelle
                If IsNumeric(rngZelle) Then
                    Select Case UCase(.Value)
                        Case Is < 14
                            .Interior.ColorIndex = 3
                        Case Is > 50
                            .Interior.ColorIndex = 5
                        Case 14 To 21
                            .Interior.ColorIndex = 6
                        Case Else
                            .Interior.ColorIndex = xlNone
                    End Select
                Else
                    Select Case UCase(.Value)
                        Case "TEST"
                            .Interior.ColorIndex = 3
                        Case Else
                            .Interior.ColorIndex = xlNone
                    End Select
                End If
            End With
        End If
    Next rngZelle
    Set rngBereich = Nothing
End Sub

Dateiupload bitte im Forum! So geht es: Klick mich!
" align="middle" height="40" alt="Grußformel">Dateiupload bitte im Forum! So geht es: Klick mich!
" align="middle" height="40" alt="Homepage">

[Crazy Tom]

Hallo Hajo, Hallo Stefan

Dank an Euch beide, funktioniert perfekt

Schönes Osterwochenende noch

MfG Tom

PS. finde nix womit ich das Thema abschließen kann