Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

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
Antworten 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 10 / Office 2016
Antworten 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
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">
Antworten 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
Antworten Top


Gehe zu:


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