Benutzerdefinierte Farbe automatisch einem Prozentwert (einer Zeile) zuordnen

[miwer]

Hallo zusammen,

1. ich habe eine Tabelle mit 100 benutzerdefinierten Farben. (RGB Format liegt vor)
2. ich habe eine Tabelle in der in einer Spalte Werte von 1-100% vorkommen. Diese Tabelle besteht aus 8 Spalten. 7 Spalten Format Standard, 1 Spalte Format Prozent

Mein Ziel,
wenn ich in eine Zelle einen Prozentwert eintrage sollen alle Zellen dieser Zeile mit dem definierten (steht in zweiter Tabelle) Farbwert versehen werden.

Ich habe es über ein Makro mit relativen Bezügen versucht, aber das Makro speichert mir immer den Wert der ersten Zelle ab. Wenn ich das Makro dann
nochmal ausführe erhalte ich in der Zeile mit einem anderen Prozentwert wieder die Farbe des ersten Prozentwertes.

Siehe Makro

Sub Farbzuordnung()
'
' Farbzuordnung Makro
'
' Tastenkombination: Strg+x
'
    ActiveCell.Offset(0, -1).Range("A1").Select
    Selection.Copy
    Sheets("Farbdefinition").Select
    ActiveCell.Columns("A:A").EntireColumn.Select
    Selection.Find(What:="68%", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, 1).Range("A1:E1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("WerteTab").Select
    ActiveCell.Offset(0, -4).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

Da ich mich nicht gut auskenne, wäre es prima, wenn mir jemand einen Denkanstoß geben könnte. Danke

[Klaus-Dieter]

Hallo,

100 Farben, - Excel ist eine Tabellenkalkulation, kein Tuschkasten.

[Gast 123]

Hallo

ich habe da mal zwei Varianten im Angebot, ohne garantieren zu können ob das so klappt??  EEn Versuch ist es wert ...
Das 1. Makro kopiert das Zellenformat aus "Farbdefinition", das 2. Makro holt sich den Zahlenwert für Font + Interior.

mfg   Gast 123

Code:

Sub Farbzuordnung()
Dim FbDef As Worksheet, PZ As Variant
Set FbDef = Sheets("Farbdefinition")
' Farbzuordnung Makro
   Sheets("WerteTab").Select
   Set rfind = FbDef.Columns(1).Find(What:=ActiveCell, After:=[a1], LookIn:= _
       xlFormulas, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
   If Not rfind Is Nothing Then
     rfind.Copy
     Cells(ActiveCell.Row, 1).Resize(1, 8).PasteSpecial xlPasteFormats
     Application.CutCopyMode = False
  End If
End Sub


Sub Farbzuordnung_2()
Dim FbDef As Worksheet, PZ As Variant
Set FbDef = Sheets("Farbdefinition")
' Farbzuordnung Makro
   Sheets("WerteTab").Select
   Set rfind = FbDef.Columns(1).Find(What:=ActiveCell, After:=[a1], LookIn:= _
       xlFormulas, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
   If Not rfind Is Nothing Then
      'Font = Schriftfarbe ; Interior = Innnfarbe
      Cells(ActiveCell.Row, 1).Resize(1, 8).Font.Color = rfind.Font.Color
      Cells(ActiveCell.Row, 1).Resize(1, 8).intrior.Color = rfind.Interior.Color
  End If
End Sub

[miwer]

Hallo,
vielen Dank für die schnelle Hilfe. Ich werde die Möglichkeiten heute Abend mal ausprobieren.
viele Grüße
miwer

[miwer]

Ja, dass sehr ich genauso, aber es ist eine Notlösung, weil
ich es nicht geschafft habe aus einer bedingten Formatierung 3 Farben Skala, die
Farben auf die Nachbarzellen der Zeile zu übertragen.
Haben Sie evtl. eine Lösung wie ich das bewerkstelligen kann?
Ich bin leider nicht fit in VBA.

Anbei ein Beispiel

Viele Grüße
miwer
  Beispiel1.xlsx (Größe: 14,56 KB / Downloads: 11)

[miwer]

Hallo,

100 Farben, - Excel ist eine Tabellenkalkulation, kein Tuschkasten.

Hallo Klaus-Dieter,
ja, dass sehe ich genauso, aber es ist eine Notlösung, weil
ich es nicht geschafft habe aus einer bedingten Formatierung (3 Farben Skala), die
Farben auf die Nachbarzellen der Zeile zu übertragen.
Haben Sie evtl. eine Lösung wie ich das bewerkstelligen kann?
Ich bin leider nicht fit in VBA.

Anbei ein Beispiel

Viele Grüße
miwer
[img]
Dateiupload bitte im Forum! So geht es: Klick mich!
]   Beispiel1.xlsx (Größe: 14,56 KB / Downloads: 1)

[Klaus-Dieter]

Hallo,

dazu brauchst du doch nur den Bereich, der gefärbt werden soll markieren, bevor du die bedingte Formatierung festlegst, dann wirkt das auf alle markierten Zellen.

[Gast 123]

Hallo

Frage an die Profis:    Warum funktioniert dieser Code NICHT ???

Ich habe in zwei Foren gestöbert ob ich bei meinem 1. Tipp was falsch gemacht habe, finde im Office Forum und Herber Archiv genau diesen Code!  
Nur, er klappt nicht!   Hier weiss ich leider selbst nicht Warum ...???   Haette es aber gerne gewusst, denn ich gebe nicht gerne "Müll" Antworten!

mfg  Gast 123

Code:

Sub Farblich_markieren()
Dim j As Integer, Farbe As Long
For j = 2 To 200
  If Cells(j, 1).Value = Empty Then Exit For
   Farbe = Cells(j, 5).Interior.Color
   Cells(j, 1).Interior.Color = Farbe
   Cells(j, 1).Resize(1, 4).Interior.Color = Farbe
NNext j
MsgBox "Ende"
End Sub

[schauan]

Hallöchen,

ich würde auf diese Zeile tippen:
If Cells(j, 1).Value = Empty
und lieber
If IsEmpty(Cells(j, 1).Value) nehmen

[miwer]

Vielen Dank für den Hinweis.
Werde ich nachher probieren 
VG
miwer