✔ Bestimmte Tabellenzeilen automatisch einfärben

[Thor_sten]

Hallo zusammen!

Ich stehe vor folgendem Problem:
Ich habe eine umfangreiche Tabelle, in der in der ersten Spalte eine Nummer steht mit unterschiedlich vielen dazugehörigen Zeilen. Ich möchte die Tabelle pro zusammenhängenden Eintrag abwechselnd hell grau und weiß einfärben.

Um das zu veranschaulichen hänge ich mal ein Bild an wie es aussehen sollte.

Jetzt stelle ich mir die Frage, ob das durch bedingte Formatierung möglich ist und wenn ja, wie? Bisher bin ich auf keinen sinnvollen Ansatz gestoßen. Oder ob es sinnvoller ist eine VBA-Programmierung vorzunehmen und diese in meine vorhandenen Makros einzubinden?

Viele Grüße

Thorsten

 

[Yaslaw]

Du kannst meine Funktion erweitern....

'/**
' * Entfernt in vorgewählten Spalten die doppelten Werte
' * @param    Dim ws As Worksheet             'Worksheet mit den zu bearbeitenden Daten
' * @param Array<Long>  Array mit den Spaltennummern, die sortiert/bearbeitet werden sollen
' *                     Währe es A, C und D, müsste der Array so aussehen: Array(1, 3, 4)
' */
Public Sub removeDoubleValuesInColumns(ByRef iWs As Worksheet, ByRef iColumns() As Variant)
    Dim rowNr As Long               'Zeilennummern
    Dim lastValues() As Variant     'Werte der Vorzeile pro Spalte
    Dim idx As Long                 'Index um durch die 2 Arrays zu iterieren
    Dim ref As Long                 'Index von Hinten gerechnet
    Dim isFirstOfGroup As Boolean   'Flag ob die Zeile ein Gruppenanfang ist
    Dim alternateColor As Boolean        'Nach jeder Gruppe switcht dieser Wert: false -> true -> false -> true
  
    'Sortierungen entfernen
    iWs.Sort.SortFields.Clear
  
    'Spalte zur Sortierung hinzufügen
    For idx = LBound(iColumns) To UBound(iColumns)
        iWs.Sort.SortFields.Add iWs.Columns(iColumns(idx))
    Next idx
  
    'befüllter Bereich zum Sortieren auswählen
    iWs.Sort.SetRange iWs.UsedRange
    'Sortierung anwenden
    iWs.Sort.Apply
  
    'Letze Werte für den Vergleich initialisieren
    ReDim lastValues(LBound(iColumns) To UBound(iColumns))
  
    'Alle Zeilen durchgehen
    For rowNr = 1 To iWs.Cells.SpecialCells(xlCellTypeLastCell).Row
        'Standardwert setzen
        isFirstOfGroup = True
        'Alle betroffenen Spalten von Vorne nach hinten durchgehen
        For idx = LBound(iColumns) To UBound(iColumns)
            'Prüfen ob Feld in der Spalte A mit dem letzten Wert übereinstimme
            If iWs.Cells(rowNr, iColumns(idx)).Value = lastValues(idx) Then
                'Wenn ja, Feld mit Null überschreiben
                iWs.Cells(rowNr, iColumns(idx)).Value = Null
                'Ist kein Gruppenanfang
                isFirstOfGroup = False
            Else
                'Ansonsten den Wert als neuen Letzten Wert übernehmen
                lastValues(idx) = iWs.Cells(rowNr, iColumns(idx)).Value
                'Alle späteren zu kontrollierenden Spalten zurücksetzen
                For ref = UBound(iColumns) To idx + 1 Step -1
                    lastValues(ref) = Null
                Next ref
            End If
        Next idx
        'Farbe switchen
        If isFirstOfGroup Then alternateColor = Not alternateColor
        'Einfärben
        iWs.Rows(rowNr).Interior.Color = IIf(alternateColor, rgbLightGrey, 0)
        iWs.Rows(rowNr).Interior.Pattern = IIf(alternateColor, xlSolid, xlNone)
    Next rowNr
End Sub

Am Ende musst du deine gewünschte Farbe abgeben

iWs.Rows(rowNr).Interior.Color = IIf(alternateColor, rgbLightGrey, 0)

 

[Thor_sten]

Super! Das klappt auf anhieb.
Vielen Dank für die schnelle Antwort @Yaslaw.