Clever-Excel-Forum

Normale Version: Zellen formatieren
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
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
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
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">
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