Das Clever-Excel-Forum.de - Treffen
findet vom 15. - 17. September 2017 in Friedrichroda /
Thüringen / Region Großer Inselsberg statt. Hotelbuchung ab sofort möglich.

Zellen formatieren
#1
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
to top
#2
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
Gruß Stefan
Win 7 / Office 2007
to top
#3
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
GrußformelHomepage
to top
#4
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
to top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste