RGB-Werte suchen und Hintergrund einstellen

[echo]

Hallo zusammen
ich habe schon mal Makros aufgezeichnet, 
aber das anpassen eines hier vorhanden Makros überschreitet deutlich meine Kenntnisse und da benötige ich Hilfe.

Ich habe hier diverse Farbfilter die nummeriert sind. 
Jedern Filter sind in einer Liste Rot / Grün / Blau Werte von 0-255 zugeordnet.
Die Filterliste hat bereits ein Makro, das eine Spalte der Liste einsprechend den RGB-Werten einfärbt / oder diese wieder aufhebt.

Dieses Einfärben hätte ich gerne, wenn möglich, auch auf einer Vorlage die später innerhalb der Arbeitsmappe mehrfach kopiert werden soll.
Gesucht wird also ein Makro, das mir aus der Filterliste die RGB-werte sucht und den Hintergrund der relevanten Zellen einstellt.

Der Rest findet sich im Beispiel
danke und gruß Holger

[schauan]

Hallöchen,

im Prinzip so:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Range("E4:F30")) Is Nothing Then Exit Sub
For Each zellen In Target
  If zellen.Value = "" Or zellen.Value = 0 Then
    zellen.Interior.Color = xlNone
  Else
    With Sheets("Filter")
      Set gefunden = .Columns(3).Find(zellen.Value)
      If Not gefunden Is Nothing Then
        zellen.Interior.Color = RGB(gefunden.Offset(, 4), gefunden.Offset(, 5), gefunden.Offset(, 6))
      End If
    End With
  End If
Next
End Sub

[AlterDresdner]

Hallo Holger,
Andre war wieder mal schneller als ich :100: .
Ich habe noch eine Textfarbe reingemurkst, die müsste im Blatt Filter sicher noch ergänzt werden.

[echo]

Möchte mich ganz herzlich bedanken. 
Beide Lösungen funktionieren einwandfrei.

Super und danke! 
Ganz wichtig in der Zeit: Passt auf euch auf und bleibt gesund!

Erledigt
Gruß Holger

[echo]

Hallo zusammen,
ich muss doch noch einmal nachfragen weil etwas passiert was ich nicht bedacht habe:
Ist die Farbe sehr dunkel kann man in der Zelle die Schrift nicht mehr vernümftig lesen 

Daher meine Bitte:
Könnte man den Code von schauan so anpassen, das man die zwei  Spalten die gefärbt werden einstellen kann.
Sinngemäß: Wenn in der Zelle eine Farbe eingetragen wird, dann stelle zwei Spalten weiter rechts die Hintergrundfarbe ein.

Danke und Gruß Holger

[schauan]

Hallöchen,

wenn Du nicht die Zelle einfärben willst sondern eine irgendwo daneben dann auch da mit Offset, z.B. nicht

zellen.Interior.Color

sondern

zellen.Offset(0,2).Interior.Color

Alternativ könnte man aber auch die Schriftfarbe übernehmen wenn Du was passendes formatierst. Das könnte auch die in der farbigen Definitionszelle sein. Siehe auch Hinweis vom AD

[echo]

Super! 
schön das man hier nachfragen kann und darf!!!

Ich habe die bed. Formatierung schon bemüht, die Transmission steht ja auch in der Filterliste. 
=Transmission<50
Schriftfarbe weiß

Ich finde es aber doch schöner daneben, und vor allen Dingen geschieht das alles im Makro.
Schönen Tage und Danke
Holger

[echo]

hallo zusammen, keines Update:

Die eingestellten Filterfarben waren nicht immer richtig. Ein wenig im Forum danach gesucht ergab folgende Änderung:
Set gefunden = .Columns(3).Find(zellen.Value)
Set gefunden = .Columns(3).Find(zellen.Value, LookIn:=xlValues, LookAt:=xlWhole)
Hoffe das das so richtig ist :)

Eine unerwartete Reaktion des Codes:
Ich habe Datenblöcke über mehrere Spalten in die Vorlage rein kopiert. 
Fällt beim reinkopieren ein Teil vom Datenblock in die Spaten der Filterfarben werden auch die anderen Teile vom Block formatiert.

Wenn sich das anpassen lässt wäre das natürlich gut, ach wenn die Zellen bei der späteren Nutzung einzeln ausgefüllt werden.
Habe die Test-Datei mit Datenblock noch mal angehängt

Gruß Holger

[schauan]

Hallöchen,

das mit dem Find passt Da sind einige Optionen, die Standard sind oder die sich Excel merkt und daher kommt es ggf. zu ungewünschten Ergebnissen, z.B. bei xlWhole oder der Alternative xlPart.

Hier noch die Codeanpassung. Ich prüfe jetzt neben dem kompletten geänderten Bereich zusätzlich, ob auch die einzelne Zelle im definierten Bereich ist

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Range("$E$4:$F$199")) Is Nothing Then Exit Sub
For Each zellen In Target
  If Not Application.Intersect(zellen, Range("$E$4:$F$199")) Is Nothing Then
    If zellen.Value = "" Or zellen.Value = 0 Then
      zellen.Offset(0, 2).Interior.Color = xlNone
    Else
      With Sheets("Filter")
        Set gefunden = .Columns(3).Find(zellen.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not gefunden Is Nothing Then
          zellen.Offset(0, 2).Interior.Color = RGB(gefunden.Offset(, 4), gefunden.Offset(, 5), gefunden.Offset(, 6))
        End If
      End With
    End If
  End If
Next
End Sub

[echo]

Hoffe, geholfen zu haben.
Grüße, André aus G in T 

 
Ja das hast du, Dankeschön und schönen Tag noch,

Holger