Makro _ Bedingte Formatierung



Excel-Version: 8.0 (Office 97)
nach unten

Betrifft: Makro _ Bedingte Formatierung
von: Wolfgang
Geschrieben am: 18.05.2002 - 19:40:47

In Excel kann man über Bedingte Formatierung nur 3 Kriterien angeben.
In Chip 02/98 gab es ein Makro, mit dem man mehrere Kriterien angeben konnte. Kann es jedoch nicht finden. Kennt jemand dieses Makro?

nach oben   nach unten

Re: Makro _ Bedingte Formatierung
von: Hajo
Geschrieben am: 18.05.2002 - 19:50:19

Hallo Wolfgang

in VBA in die Tabelle


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'   Schrift
    Dim Bereich As Range
    Dim Z
'   Bereich der Wirksamkeit
    Set Bereich = Range("B3:C20")
'   überprüfen ob mehr als eine Zelle markiert $A$1:$B$3
'   wurde mehere Zellen markiert ist wert größer 0
    If InStr(Target.Address, ":") = 0 Then
        If Intersect(Target, Bereich) Is Nothing Then Exit Sub  ' Abbruch, wenn Aktion nicht im Zielbereich
'       Kreuz entfernen
        Target.Borders(xlDiagonalDown).LineStyle = xlNone
        Target.Borders(xlDiagonalUp).LineStyle = xlNone
'       Schriftfarbe setzen
        Select Case Target.Value
            Case "1"
'               mal eine andere Variante Kreuz in Zelle
                With Target.Borders(xlDiagonalDown)
                    .LineStyle = xlContinuous
                    .Weight = xlThick
                End With
                With Target.Borders(xlDiagonalUp)
                    .LineStyle = xlContinuous
                    .Weight = xlThick
                End With
                Target.Font.ColorIndex = 0
            Case "2"
                Target.Font.ColorIndex = 2
                ' weiß
            Case "3"
                Target.Font.ColorIndex = 3
                ' rot
'           usw.
            Case Else
                Target.Font.ColorIndex = 0
        End Select
    Else
'       es wurden mehere Zellen markiert
        For Each Z In Selection
'           überprüfen ob Zelle im vorgegebenen Bereich
            If Intersect(Z, Bereich) Is Nothing Then
            Else
'               Kreuz entfernen
                Z.Borders(xlDiagonalDown).LineStyle = xlNone
                Z.Borders(xlDiagonalUp).LineStyle = xlNone
                Select Case Z.Value
'                   Select case Anweisung wie oben
                    Case "1"
                        With Z
                            With .Borders(xlDiagonalDown)
                                .LineStyle = xlContinuous
                                .Weight = xlThick
                            End With
                            With .Borders(xlDiagonalUp)
                                .LineStyle = xlContinuous
                                .Weight = xlThick
                            End With
                        End With
                        Z.Font.ColorIndex = 0
                    Case "2"
                        Z.Font.ColorIndex = 2
                        ' weiß
                    Case "3"
                        Z.Font.ColorIndex = 3
                        ' rot
'                   usw.
                    Case Else
                        Z.Font.ColorIndex = 0
                End Select
            End If
        Next Z
    End If
End Sub

Gruß Hajo

 nach oben

Beiträge aus den Excel-Beispielen zum Thema "Makro _ Bedingte Formatierung"