Zeilen abwechselnd farbig markieren entsprechend dem Wert in einer bestimmten Spalte?
Ich habe eine Excel-Tabelle, die z.B. nach Spalte E sortiert ist:
E1 "100"
E2 "100"
E3 "100"
E4 "200"
E5 "300"
E6 "300"
E7 "400"
Nun möchte ich die Zeilen so einfärben, daß sie wie folgt aussehen:
Zeile1 blau
Zeile 2 blau
Zeile 3 blau
Zeile 4 weiß
Zeile 5 blau
Zeile 6 blau
Zeile 7 weiß
also, wenn in Spalte E der Wert gleich ist, wie in der Zelle darüber, dann die gleiche Farbe für die ganze Zeile. Wenn sich der Wert ändert, dann die andere Farbe. usw.
Läßt sich das realisieren? Wenn ja, wie?
Am besten wäre natürlich ein Makro.
2 Antworten
Hallo,
wenn die Tabelle schon sortiert ist, muss man ja nur alle Zeilen nacheinander abgehen und bei einer Nichtübereinstimmung mit dem Voreintrag die Farbe wechseln:
Sub farbwechseln()
Dim Farbe As Boolean
Dim farA As Long, farB As Long, FarF As Long, lZei As Long, z As Long
farA = RGB(180, 200, 220)
farB = RGB(255, 255, 255)
FarF = farA
Farbe = True
With ActiveSheet
lZei = .Range("E" & .Rows.Count).End(xlUp).Row
.Range("E1").EntireRow.Interior.Color = FarF
If lZei > 1 Then
For z = 2 To lZei
If .Range("E" & z).Value <> .Range("E" & z - 1).Value Then
'Variante einfärben
'If FarF = farA Then
' FarF = farB
'Else
' FarF = farA
'End If
'Variante Farbe-nichts wechseln
If Farbe Then
Farbe = False
Else
Farbe = True
End If
End If
'Variante einfärben
' .Range("E" & z).EntireRow.Interior.Color = FarF
'Variante Farbe-nichts wechseln
If Farbe Then
.Range("E" & z).EntireRow.Interior.Color = FarF
Else
With .Range("E" & z).EntireRow.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next z
End If
End With
End Sub
Bitte :D,
ja das ist machbar. Man muss nur entsprechend die Bereiche festlegen. Wobei es dann vermutlich auch sinnvoll ist, wenn der Code gleich nach der Spalte sortieren kann:
Sub farbwechseln2()
Dim Farbe As Boolean
Dim farA As Long, farB As Long, FarF As Long, lZei As Long, z As Long, dummy As Long
Dim aCe As Range, gesBer As Range, hiSpa As Range, zelle As Range
farA = RGB(160, 240, 240)
farB = RGB(15, 225, 150)
'Bereich festlegen
Set gesBer = ActiveSheet.Range("A1:E1") 'Spalten an deine Tabelle anpassen, Zeilen werden anschließend automatisch bis zur letzten erweitert
On Error GoTo Errorhandler
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set aCe = ActiveCell
With ActiveSheet
'Bereich bis zur letzten Zeile erweitern
For Each zelle In gesBer 'letzten Eintrag finden
lZei = Application.WorksheetFunction.Max(lZei, .Cells(.Rows.Count, zelle.Column).End(xlUp).Row)
Next zelle
Set gesBer = gesBer.Resize(lZei - gesBer.Row + 1, gesBer.Columns.Count)
If Intersect(aCe, gesBer) Is Nothing Then
MsgBox "Die Zelle " & aCe.Address(False, False) & " befindet sich nicht im angegebenen Bereich der Tabelle " & gesBer.Address(False, False) & Chr(10) & "Der Vorgang wurde abgebrochen.", 48
GoTo Fin
End If
dummy = MsgBox("Soll Spalte " & Left(aCe.Address(True, False), InStr(1, aCe.Address(True, False), "$") - 1) & " aufsteigend sortiert werden?", 36)
If dummy = 6 Then
'aktive Spalte aufsteigend sortieren
With .Sort
.SortFields.Clear
.SortFields.Add Key:=aCe
.SetRange gesBer
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
'einfärben
FarF = farA
Farbe = True
Set hiSpa = .Range(.Cells(gesBer.Row, aCe.Column), .Cells(gesBer.Rows.Count - gesBer.Row + 1, aCe.Column))
For Each zelle In hiSpa
If zelle.Row <> gesBer.Row Then
'erste Zeile im Bereich nicht auf Vorgänger prüfen
If zelle.Value <> zelle.Offset(-1, 0).Value Then
If Farbe Then
Farbe = False
'FarF = farB
Else
Farbe = True
'FarF = farA
End If
End If
End If
If Farbe Then
'einfärben
zelle.EntireRow.Interior.Color = FarF
Else
'Farbe entfernen
With zelle.EntireRow.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'zelle.EntireRow.Interior.Color = FarF
End If
Next zelle
End With
Fin:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub
Errorhandler:
MsgBox "Ein Fehler ist aufgetreten."
GoTo Fin
End Sub
Cool, das funktioniert bei einer "normalen" Tabelle in Excel wunderbar.
Wenn ich aber eine Tabelle mit STRG-T erzeuge, werden die Spaltenüberschriften mit sortiert - das ist natürlich blöd ;-)
Im ersten Code "farbwechseln" sprichst du ja die Zeile "E" geziehlt an. Wäre es nicht möglich, da eine Abfrage zu machen? So nach dem Motto: wenn der Curser in Spalte "D" ist, dann nimm die Spalte "D"? Die Sortierung der entsprechenden Spalte könnte ich ja vorher machen.
Und vielen Dank für deine Hilfe! Mit Excel-Formeln komme ich schon recht gut zurecht, aber VBA... , da verstehe ich fast nur Bahnhof .-)
werden die Spaltenüberschriften mit sortiert - das ist natürlich blöd
In der Tat, ich hatte es beim Sortiervorgang Excel überlassen zu ermitteln ob die Tabelle Überschriften enthällt. Das es sie nicht als solche erkennt ist unerwartet, aber man kann ihm gleich sagen das es von Überschriften ausgehen soll. Dazu muss man nur im Abschnitt " 'aktive Spalte aufsteigend sortieren"
.Header = xlGuess
'ändern zu
.Header = xlYes
sprichst du ja die Zeile "E" gezielt an. Wäre es nicht möglich, da eine Abfrage zu machen? [..] Die Sortierung der entsprechenden Spalte könnte ich ja vorher machen.
Die Sortierung in farbwechseln2 ist optional, daher ja die Frage ob sortiert werden soll beim Ausführen^^. Bei Nein wird so eingefärbt wie die Werte gerade in der Spalte der aktiven Zelle stehen.
Das Umwandleln der aktiven Zelle in die entsprechende Spalte ist aber auch möglich und nebenbei bereits in farbwechseln2 enthalten gewesen. Dies kann man in einer Variable speichern und anstelle der "E"s benutzen. In farbwechseln2 war nur wegen der Sortierung ein anderes Ansprechen nötig, das ich anschließend weiter verwendet hatte.
Set aCe = ActiveCell
SpaBu = Left(aCe.Address(True, False), InStr(1, aCe.Address(True, False), "$") - 1)
Activesheet.Range(SpaBu & "1").EntireRow.Interior.Color = FarF
Super! Ich nehme jetzt die farbwechsel2-Variante. Habe beide Versionen entsprechend hinterlegt, also die mit und die ohne Überschriften.
Wenn ich mal mehr Zeit habe, versuche ich das script mal richtig zu verstehen, du hast das ja auch alles ganz toll kommentiert - Danke.
Du kannst da etwas mit der "Bedingten Formatierung" machen. Diese findest du unter dem Reiter "Start". Ob es aber genau so geht, wie du möchtest, müsstest du ausprobieren.
Danke für die schnelle Antwort, aber ganau da komme ich ja nicht weiter....
Vielen, vielen Dank! Das ist genau das, was ich gesucht habe!
Ist es auch machbar, statt der Spalte E die Spalte zu verwenden, in der sich der Curser befindet? - Also als relativer Verweis?