Office: (Office 2019) Zeile Einfügen mit Bedingung Farbe der letzten Beschriebenen Zeile

Nabend Allerseits,

Frage:
Ich möchte via VBA nach der letzte Zeile suchen die Beschrieben ist u. dessen Hintergrund Farbe herausfinden.

Ziel:
Ich möchte via Bedingung eine neue Zeile hinzufügen.

Bedingung 1 = Hat die letzte Beschriebene Zeile die Hintergrundfarbe "RGB(201, 201, 201) ==> Grau, Akzent3, heller 40%"
Dann: Füge eine neue Zeile ein mit der Hintergrundfarbe "RGB(165, 165, 165) ==> 'Grau, Akzent3"

Bedingung 2 = Hat die letzte Beschriebene Zeile die Hintergrundfarbe "RGB(165, 165, 165) ==> 'Grau, Akzent3"
Dann: Füge eine neue Zeile ein mit der Hintergrundfarbe "RGB(201, 201, 201) ==> Grau, Akzent3, heller 40%"

Verwendete Elemente:
Zellenbereich: A:AL
Zeile 1, Beschriftung
Zeile 2, Erste Zeile mit Werten u. hat die Hintergrundfarbe "RGB(201, 201, 201) ==> Grau, Akzent3, heller 40%"
Zeile 3, Zweite Zeile mit Werten u. hat die Hintergrundfarbe "RGB(165, 165, 165) ==> 'Grau, Akzent3"
Ich Spreche die Tabelle über ActiveSheet an.

Die Befüllung der Tabelle mit Daten ist OpenEnd

Danke im Voraus!
Ich sitze schon seit einer Weile dran.

Grus Leon

 

Hallo,

was du da beschreibst, ist im Prinzip eine formatierte (intelligente) Tabelle. Damit lässt sich das am einfachsten realisieren. Da man da auch eigene Formatvorlagen erstellen kann, kannst du das auch mit deinen Lieblingsgrautönen tun.

 

Hallo Klaus-Dieter,

danke für deine Antwort. Allerdings ist dies für mich u. mein Projekt keine Option.
Wie bereits erwähnt möchte ich das via VBA lösen. Die Frage war doch Gestellt...

Mittlerweile sitze ich bereits eine längere Zeit dran um es selbständig zu lösen was nicht klappt.

Ihr eine Demo-Mappe anbei.

Gruß Leon

 

Hallo Leon,

ich hatte den Wunsch nach einer VBA-Lösung schon gesehen, nur ist VBA kein Allheilmittel. Natürlich kann man damit Zeilen oder Teile davon einfärben. Aber was ist, wenn die Liste Sortiert oder gefiltert werden soll, dann wird es mit VBA schwierig.

 

Hallo Leon,

die Farbnummer also nicht RGB kann man so:

Code:

Sub FarbNummerletzteBeschriebeneZeile()
    Dim Z As Range
    For Each Z In Tabelle1.UsedRange
        If Z = "" Then MsgBox "Farbnummer der Zeile: " & Z.Interior.Color
    Next
End Sub

auslesen. Deine RGB Werte sin auch nur Farbnummern also:
13224393 Farbnummer für RGB(165, 165, 165) und 10855845 Farbnummer für RGB(201, 201, 201)
Was jetzt völlig unklar ist, soll die neue Zeile mit dem komplementären Farbwert hinter dem UsedRange gefärbt werden oder nach der letzten beschriebenen Zeile.
Das Gerüst dafür wäre anpassbar für beide Wege so:

Code:

Sub FarbNummerletzteBeschriebeneZeile()
    Dim Z As Range, colZ1&, colZ2&
    colZ1 = 13224393    ' Farbnummer für RGB(165, 165, 165)
    colZ2 = 10855845    ' Farbnummer für RGB(201, 201, 201)
    For Each Z In Tabelle1.UsedRange
        If Z = "" Then
            If Z.Interior.Color = 13224393 Then
                ' hier je nach dem
                Exit Sub
            ElseIf Z.Interior.Color = 10855845 Then
                ' hier je nach dem
                Exit Sub
            Else
                MsgBox "Farbwert nicht gefunden"
            End If
        End If
    Next
End Sub

Gruß Uwe

 

Hi Leon,

also irgendwie passt deine Beschreibung nicht zu dem, was das Makro machen soll.

Du willst am Ende der Tabelle eine Zeile einfügen. Warum, Einfärben reicht doch. Mal ganz auf die Schnelle:

Sub sbMitMod()
Dim i As Long
Dim j As Long
i = Cells(1048576, 1).End(xlUp).Row + 1
j = i Mod 2
If j = 1 Then
Range(Cells(i, 1), Cells(i, 38)).Interior.Color = RGB(165, 165, 165)
Else
Range(Cells(i, 1), Cells(i, 38)).Interior.Color = RGB(201, 201, 201)
End If
End Sub

Gruß
Jürgen

 

Hallo Leon,

anbei ein kleines Makro, dass deine Wünsche erfüllen könnte. Aber mit der Einschränkung, dass Filtern und Sortieren die Farbgebung durcheinander bringen wird.

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lngLeZeile As Long
    Dim lngFarb As Long
    Dim varFarbArr As Variant
    Dim isect As Range
    Set isect = Application.Intersect(Target, Columns(1))
    If Not isect Is Nothing Then
        varFarbArr = Array(13224393, 10855845)
        lngLeZeile = Range("A1").End(xlDown).Row
        Range("A" & Target.Row, "AL" & Target.Row).Interior.Color = varFarbArr(Target.Row Mod 2)
    End If
End Sub

 

Hi
wenn du nicht weiß, in welcher Spalte du suchen musst, findest du die letzte beschriebene Zeile mit:

cells.Find(what:="?*", lookat:=xlwhole, lookin:=xlformulas, searchdirection:=xlPrevious,searchorder:=xlByRows)

wenn es eine Spalte gibt, in der du suchen kannst dann einfacher mit

Cells(Rows.Count, 1).End(xlup)

du bekommst dann jeweils eine Zelle der letzten beschriebenen Zeile.

Gruß Daniel