Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Benutzerdefinierte Farbe automatisch einem Prozentwert (einer Zeile) zuordnen
#1
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
Antworten Top
#2
Hallo,

100 Farben, - Excel ist eine Tabellenkalkulation, kein Tuschkasten.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
Antworten Top
#3
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
Antworten Top
#4
Hallo,
vielen Dank für die schnelle Hilfe. Ich werde die Möglichkeiten heute Abend mal ausprobieren.
viele Grüße
miwer
Antworten Top
#5
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
.xlsx   Beispiel1.xlsx (Größe: 14,56 KB / Downloads: 11)
Antworten Top
#6
(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)
Antworten Top
#7
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.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
Antworten Top
#8
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
[-] Folgende(r) 1 Nutzer sagt Danke an Gast 123 für diesen Beitrag:
  • miwer
Antworten Top
#9
Hallöchen,

ich würde auf diese Zeile tippen:
If Cells(j, 1).Value = Empty
und lieber
If IsEmpty(Cells(j, 1).Value) nehmen
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#10
Vielen Dank für den Hinweis.
Werde ich nachher probieren 
VG
miwer
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste