37414
Goto Top

Excel 2016 - zusammengehörende Zeilen mit unterschiedlicher Anzahl automatisch einfärben

Hallo an Alle.

Ich weiß zwar, wie man in Excel 2016 eine größere Tabelle übersichtlicher macht, indem man einfach jede zweite Zeile in einer anderen Farbe formatiert.

Nur habe ich bisher noch nicht herausgefunden, wie man das macht, wenn eine jeweils unterschiedliche Anzahl von Zeilen in einer bestimmten Farbe dargestellt werden soll.

Zum besseren Verständnis, hier mal ein Beispiel, welches ich natürlich manuell formatiert habe face-smile

unterschiedliche Zeilen automatisch einfärben

In meiner Original-Datei sind es eine Menge solcher Zeilen, mit jeweils unterschiedlichem Umfang, die eingefärbt werden müssen.
Das Problem dabei ist, dass die gesamte Liste ALPHABETISCH sortiert sein muss. Daher muss ich immer wieder mehrere Zeilen dazwischen einfügen und dann muss ich im Moment den kompletten Rest wieder umfärben... das ist echt ziemlich ätzend face-wink

Vielleicht gibt es ja eine Möglichkeit, das umzusetzen.

Gruß,
imebro

Content-Key: 608437

Url: https://administrator.de/contentid/608437

Printed on: April 25, 2024 at 04:04 o'clock

Mitglied: 145916
145916 Sep 29, 2020 updated at 14:20:02 (UTC)
Goto Top
Sub ColorRows()
    Dim cell As Range, color1 As Variant, color2 As Variant, rowColor As Variant
    color1 = vbWhite
    color2 = vbCyan
    With ActiveSheet
        For Each cell In .Range("A4:A" & .Cells(Rows.Count, "A").End(xlUp).Row)  
            If cell.Font.Bold Then
                rowColor = IIf(rowColor = color1, color2, color1)
            End If
            cell.EntireRow.Interior.Color = rowColor
        Next
    End With
End Sub
Mitglied: 37414
37414 Sep 30, 2020 updated at 06:41:00 (UTC)
Goto Top
Hallo und danke für Deine Mühe.

Grundsätzlich funktioniert Dein Code gut.
Leider ist das Ergebnis jedoch noch nicht ganz richtig und ich kann (noch) nicht ergründen, wo der Fehler liegt.
Die Farbe (Cyan) geht hier einfach rechts zu weit raus und unten zu weit runter.

Hier siehst Du das Ergebnis:

colorrows1

Im Code habe ich daher mal Deine Code-Zeile 6 verändert, indem ich dort den ganzen Tabellenbereich eingegeben habe ("A4:B22"):

Sub ColorRows()
    Dim cell As Range, color1 As Variant, color2 As Variant, rowColor As Variant
    color1 = vbWhite
    color2 = vbCyan
    With ActiveSheet
        For Each cell In .Range("A4:B22" & .Cells(Rows.Count, "A").End(xlUp).Row)  
            If cell.Font.Bold Then
                rowColor = IIf(rowColor = color1, color2, color1)
            End If
            cell.EntireRow.Interior.Color = rowColor
        Next
    End With
End Sub

Aber auch das brachte keine Veränderung.
Da sich die Tabelle ja immer mehr nach unten verlängert, je mehr Einträge man vornimmt, müßte die Einfärbung immer automatisch bis zum Tabellenende gehen. Oder - alternativ - könnte man auch die ganze Tabelle markieren und dann den Code ausführen... falls es eine solche Option überhaupt gibt face-smile

Und eine weitere Frage wäre, ob ich auch Farben in Hexadezimalen Codes eingeben kann?
Ich würde z.B. als zweite Farbe zu Weiß noch die Farbe hellgrün eingeben: #e2efda

Gruß,
imebro
Mitglied: 37414
37414 Sep 30, 2020 updated at 07:07:39 (UTC)
Goto Top
...bin schon ein Stückchen weiter gekommen.

Die Zeile 6 habe ich jetzt nochmal angepaßt wie folgt:

"A4:A" & .Cells(Rows.Count, 1  

Also nur eine 1 statt des A

Damit stoppt die Einfärbung auf jeden Fall korrekt am Tabellenende.
Jetzt müßte sie nur auch rechts noch am Tabellenende stoppen.

Wie mache ich das?

Gruß,
imebro
Mitglied: 37414
37414 Sep 30, 2020 updated at 07:58:57 (UTC)
Goto Top
Ich habe nochmal recherchiert und im Internet einen Hinweis gefunden, dass wohl auch die X-Achse im Code genannt werden muss.
Habe dann einfach mal herumprobiert, wie man im unten stehenden Code in Zeile 11 sieht. Hat aber nicht funktioniert face-wink

Sub ColorRows()
    Dim cell As Range, color1 As Variant, color2 As Variant, rowColor As Variant
    color1 = vbWhite
    color2 = vbCyan
    With ActiveSheet
        For Each cell In .Range("A4:A" & .Cells(Rows.Count, 1).End(xlUp).Row)  
            If cell.Font.Bold Then
                rowColor = IIf(rowColor = color1, color2, color1)
            End If
            cell.EntireRow.Interior.Color = rowColor
            LastCol = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
        Next
    End With
End Sub

Vielleicht fällt Dir/Euch ja noch was ein, wie man die Einfärbung auch nach rechts, bis zum Tabellenende beschränkt, bzw. wie man den Code für die X-Achse korrekt in den vorhandenen Code einfügt.

Gruß,
imebro
Mitglied: 37414
37414 Oct 29, 2020 at 14:50:31 (UTC)
Goto Top
Hallo,

könnte hierzu ggf. nochmal Jemand von Euch was schreiben?
Grds. funktioniert der Code ja... aber die Farbbalken werden nun zwar nicht mehr nach unten, jedoch noch immer nach rechts zu weit rausgezogen.

Wie kann ich das verhindern?

LG
imebro