Clever-Excel-Forum - Benutzerdefinierte Farbe automatisch einem Prozentwert (einer Zeile) zuordnen

Seiten: 1 2

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

Hallo,

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

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

Hallo,
vielen Dank für die schnelle Hilfe. Ich werde die Möglichkeiten heute Abend mal ausprobieren.
viele Grüße
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[attachment=24614]

(04.06.2019, 20:19)Klaus-Dieter schrieb: [ -> ]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)

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.

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

Hallöchen,

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

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

Seiten: 1 2