Supportnet / Forum / Tabellenkalkulation
Bedingte Formatierung, die xte
Frage
Hallo zusammen,
ich weiß, dass es über das Thema "bedingte Formatierung schon diverse Threats gibt. Leider finde ich darin trotzdem nicht die Lösung für mein Problem.
Meine Tabelle besteht aus den Spalten A-W. Die Form, wie sie vorhanden ist, wird jeden Tag durch ein recht großes Makro erstellt, weil am Tag diverse Personen (alle Excel-Frischlinge) mit der Tabelle arbeiten müssen.
zum Problem:
Wenn man in Spalte J etwas eingibt, dann soll die Schrift aller Eintragungen in den Spalten B-J dieser Zeile grau werden. Und wenn man ein "ed" in die Spalte F eingibt, soll die Zeile (auch nur die Spalten B-J) schwarz hinterlegt werden.
Und das soll dann auch noch in das Makro geschrieben werden.
Gibt es dazu eine Möglichkeit?
Vielen Dank vorab für Eure Hilfe.
Gruß
Fubajunkie
Antwort 1 von Ahnan
Hallo,
so geht es zum Beispiel:
Option Explicit
Sub Mit_Farbe_hervorheben()
Dim Zelle, ersteAdresse, Rows As Range
Dim ini As Long
With ActiveSheet.Range("J:J")
Set Zelle = .Find("*", LookIn:=xlValues)
If Not Zelle Is Nothing Then
ersteAdresse = Zelle.Address
Do
For ini = 2 To 10
Cells(Zelle.Row, ini).Font.ColorIndex = 16
Next ini
Set Zelle = .FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> ersteAdresse
End If
End With
With ActiveSheet.Range("F:F")
Set Zelle = .Find("ed", LookIn:=xlValues)
If Not Zelle Is Nothing Then
ersteAdresse = Zelle.Address
Do
For ini = 2 To 10
Cells(Zelle.Row, ini).Interior.ColorIndex = 1
Next ini
Set Zelle = .FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> ersteAdresse
End If
End With
End Sub
Wenn du das in
Private Sub Worksheet_Change(ByVal Target As Range)
Mit_Farbe_hervorheben
End Sub
einfügst, funktioniert es bei jeder Zelleingabe im entsprechenden Arbeitsblatt !
MfG
so geht es zum Beispiel:
Option Explicit
Sub Mit_Farbe_hervorheben()
Dim Zelle, ersteAdresse, Rows As Range
Dim ini As Long
With ActiveSheet.Range("J:J")
Set Zelle = .Find("*", LookIn:=xlValues)
If Not Zelle Is Nothing Then
ersteAdresse = Zelle.Address
Do
For ini = 2 To 10
Cells(Zelle.Row, ini).Font.ColorIndex = 16
Next ini
Set Zelle = .FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> ersteAdresse
End If
End With
With ActiveSheet.Range("F:F")
Set Zelle = .Find("ed", LookIn:=xlValues)
If Not Zelle Is Nothing Then
ersteAdresse = Zelle.Address
Do
For ini = 2 To 10
Cells(Zelle.Row, ini).Interior.ColorIndex = 1
Next ini
Set Zelle = .FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> ersteAdresse
End If
End With
End Sub
Wenn du das in
Private Sub Worksheet_Change(ByVal Target As Range)
Mit_Farbe_hervorheben
End Sub
einfügst, funktioniert es bei jeder Zelleingabe im entsprechenden Arbeitsblatt !
MfG