Microsoft Excel

Herbers Excel/VBA-Archiv

Bedingte Formatierung | Herbers Excel-Forum


Betrifft: Bedingte Formatierung von: UweD
Geschrieben am: 20.02.2009 16:42:16

Hallo

ich sitze jetzt seit einiger Zeit vor der Tabelle:

über das Worksheet_SelectionChange ausgelöst möchte ich, wenn ich in Spalte D eine Zelle auswähle
alle Zellen grün färben (von Spalte A bis L), die in Spalte D den gleichen Wert haben.

Ich bekomm es einfach nicht hin.

Das hier färbt nur die Werte in D....

Wer kann mir helfen. Ggf. ist mein Ansatz ja auch kompl. falsch???

Excel 2007



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("D:D")) Is Nothing Then
        Dim Z&, LR&
        LR = Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte
        If Target.Row <= LR Then
            Z = Target.Row 'aktuelle Zeile
            With Range("D2:D" & LR)
                Cells.FormatConditions.Delete
                .FormatConditions.Add Type:=xlExpression, Formula1:="=D" & Z & "=$D$" & Z
                .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

                With .FormatConditions(1).Interior 'grüner Hintegrund
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent3
                    .TintAndShade = 0.399945066682943
                End With

            End With
        End If
    End If

End Sub

Code eingefügt mit Syntaxhighlighter 4.14


Danke

Gruß UweD

  

Betrifft: With Range("A2:L" & LR) oT von: Matthias L
Geschrieben am: 20.02.2009 17:37:33




  

Betrifft: klick auf D1 läuft so aber auf einen Fehler ! ... von: Matthias L
Geschrieben am: 20.02.2009 17:52:03

Hallo nochmal

Übrigens ein Klick auf D1 löst in VBA einen Fehler aus,
schon bemerkt?

Vorschlg:

Option Explicit
'https://www.herber.de/ _
forum/archiv/1052to1056/t1052497.htm

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Dim Z&, LR&
 If Not Intersect(Target, Range("D:D")) Is Nothing Then
    LR = Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte
    If Target.Row <= LR And Target.Row > 1 Then
       Z = Target.Row 'aktuelle Zeile
       With Range("A2:L" & LR)
           Cells.FormatConditions.Delete
           .FormatConditions.Add Type:=xlExpression, Formula1:="=D" & Z & "=$D$" & Z
           .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
           With .FormatConditions(1).Interior 'grüner Hintegrund
               .PatternColorIndex = xlAutomatic
               .ThemeColor = xlThemeColorAccent3
               .TintAndShade = 0.399945066682943
           End With
       End With
    End If
 End If
 End Sub





Gruß Matthias


  

Betrifft: AW: Bedingte Formatierung von: Tino
Geschrieben am: 20.02.2009 17:55:57

Hallo,
versuche es mal hiermit.

Kommt als Code in das entsprechende Tabellenblatt.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Bereich As Range, rZelle As Range
Dim Anzahl As Long

With Application
 .ScreenUpdating = False
 .EnableEvents = False
    'Farben zurücksetzen 
    Range("A:L").Interior.ColorIndex = xlNone

         If Not Intersect(Target, Columns(4)) Is Nothing Then
            'Bereich 
            Set Bereich = Range("D1", Cells(Rows.Count, 4).End(xlUp))
            'Anzahl Zellen 
            Anzahl = Application.WorksheetFunction.CountIf(Bereich, Target)
            'Schleife über die Zellen 
            For Anzahl = 1 To Anzahl
             If Anzahl = 1 Then
              Set rZelle = Bereich.Find(Target, , xlValues, 2, 1, xlNext, False, False, False)
              Range(Cells(rZelle.Row, 1), Cells(rZelle.Row, 12)).Interior.ColorIndex = 4
             Else
              Set rZelle = Bereich.FindNext(rZelle)
              Range(Cells(rZelle.Row, 1), Cells(rZelle.Row, 12)).Interior.ColorIndex = 4
             End If
            Next Anzahl
         End If
 
 .ScreenUpdating = True
 .EnableEvents = True
End With
End Sub



Gruß Tino


  

Betrifft: besser so von: Tino
Geschrieben am: 20.02.2009 18:05:22

Hallo,
besser geht es hiermit, wenn Du mehrere Zellen auf einmal auswählst.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Bereich As Range, rZelle As Range, meTarget As Range
Dim Anzahl As Long

With Application
 .ScreenUpdating = False
 .EnableEvents = False
    'Farben zurücksetzen 
    Range("A:L").Interior.ColorIndex = xlNone
       For Each meTarget In Target
         If Not Intersect(meTarget, Columns(4)) Is Nothing And meTarget <> "" Then
            'Bereich 
            Set Bereich = Range("D1", Cells(Rows.Count, 4).End(xlUp))
            'Anzahl Zellen 
            Anzahl = Application.WorksheetFunction.CountIf(Bereich, meTarget)
            'Schleife über die Zellen 
            For Anzahl = 1 To Anzahl
             If Anzahl = 1 Then
              Set rZelle = Bereich.Find(meTarget, , xlValues, 2, 1, xlNext, False, False, False)
              Range(Cells(rZelle.Row, 1), Cells(rZelle.Row, 12)).Interior.ColorIndex = 4
             Else
              Set rZelle = Bereich.FindNext(rZelle)
              Range(Cells(rZelle.Row, 1), Cells(rZelle.Row, 12)).Interior.ColorIndex = 4
             End If
            Next Anzahl
         End If
        Next meTarget
 .ScreenUpdating = True
 .EnableEvents = True
End With
End Sub



Gruß Tino


  

Betrifft: Danke an alle von: UweD
Geschrieben am: 23.02.2009 10:50:22

...für die Hilfe.



Ich habe es jetzt so gelöst.



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Z&, LR&
    If Not Intersect(Target, Range("D:D")) Is Nothing Then
        LR = Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte
        If Target.Row <= LR And Target.Row > 1 Then
            Z = Target.Row 'aktuelle Zeile
            With Range("A2:L" & LR)
                Cells.FormatConditions.Delete
                .FormatConditions.Add Type:=xlExpression, Formula1:= _
                    "=$D" & Z & "=" & Target.Value
                .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
                With .FormatConditions(1).Interior 'grüner Hintegrund
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent3
                    .TintAndShade = 0.399945066682943
                End With
            End With
        End If
    End If
 End Sub

Code eingefügt mit Syntaxhighlighter 4.14




Wichtig war mir, das die Zeile von A bis L kompl. markiert wird.

Gruß UweD


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