Frage von qwertz6561, 49

VBA picklist formatierung?

Hi,

Und zwar habe ich eine Liste an Werten die eine bestimmte Farbe/Schriftfarbe annehmen. Ich weiß eigentlich würde ich es auch mit bedingter Formatierung machen, aber das Problem ist dass meine Combobox 30 Werte hat und 30 mal eine bedingte Formatierung machen ist nicht gerade so toll :). Wie kann ich das schneller oder einfacher machen?

P.S: Es handelt sich nicht um eine Userform sondern um eine Zelle die ein Auswahlfeld mit verschiedenen Inhalten (Picklist werten).

Hilfreichste Antwort - ausgezeichnet vom Fragesteller
von Ninombre, Community-Experte für Excel, 26

Es geht um die Datenüberprüfung > Liste aka Picklist oder Dropdown, richtig?

Sind die 30 Auswahlwerte in der Tabelle irgendwo hinterlegt oder nur direkt in der Datenüberprüfung? In ersterem Fall könnte man in dieser Liste die entsprechende Formatierung hinterlegen und per VBA übertragen.


Kommentar von qwertz6561 ,

In einem anderen Tabellenblatt hinterlegt. 

Also z.B. Tabellenblatt "Pick List" und da die Range C2 bis C32

Und "Tabelle1" wäre dann die Spalte D wo die Datenüberprüfung > Liste stattfindet

Kommentar von Ninombre ,

Makro anlegen: Ribbon Entwicklerwerkzeuge > VBA
Dort ist links eine Ordnerstruktur. Zum Tabellenblatt 1 folgendes hineinkopieren

Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("D1:D100")) Is Nothing Then
On Error Resume Next
Target.Font.Color = Cells(WorksheetFunction.Match(Target.Value, Sheets("Pick List").Range("C2:C32"), 0), 12).Font.Color
End If
End Sub

Den Bereich, in dem das Pickup verwendet werden kann und für den die Schriftfarbe übernommen wird, habe ich mal mit D1:D100 gewählt. Das kannst Du beliebig erweitern.

Was tut das ganze? Worksheet_change wird bei jeder Änderung auf der Tabelle 1 angestoßen. Wenn die Änderung nicht im Bereich D1:D100 war, passiert ncihts. Ansonsten wird im Tabellenblatt Pick List nach dem gerade gesetzten Wert gesucht und die Schriftfarbe der Zelle übernommen. Sollen außer der Schriftfarbe noch weitere Formatierungen gesetzt werden? Die sind jetzt noch nicht drin.
Naheliegender Voraussetzung: Die Einträge in der Pick-List müssen die gewünschte Schriftfarbe haben.

Kommentar von qwertz6561 ,

Schriftfarbe+Hintergrundfarbe der befindlichen Zelle aus der Pick Liste

Ich habe eine Frage. Im Change Event Sub ist ein anderes Makro für etwas anderes drin (von meinem Kollegen). Soll ich dann diesen Makro separieren und vom Change Event aus aufrufen (Call x) ? Oder kann ich auch es einfach drunter reinkopieren vor End Sub ?

Kommentar von Ninombre ,

Ach, das ist ein typischer Fall, wo ich was als simples Beispiel konzipiere und dann nicht alle Änderungen drin sind für Deinen tatsächlichen Fall.

Wenn Du das bisherigen worksheet_change beibehalten willst, dann in die erste Zeile das fettgedruckte. Ganz an den Anfang, weil vermutlich im bestehenden Makro nur etwas abläuft, wenn die geänderte Zelle in einem bestimmten Bereich liegt

Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("D1:D100")) Is Nothing Then call formatierung(target)End Sub

Dann neues Makro:

Sub formatierung(zelle As Range)
On Error Resume Next
zelle.Font.Color = Sheets("Pick List").Cells(WorksheetFunction.Match(zelle.Value, Sheets("Pick List").Range("C2:C32"), 0) + 1, 3).Font.Color
zelle.Interior.Color = Sheets("Pick List").Cells(WorksheetFunction.Match(zelle.Value, Sheets("Pick List").Range("C2:C32"), 0) + 1, 3).Interior.Color
End Sub

Hier waren beim Übertragen aus meinem Beispiel einige Stellen nicht richtig

Kommentar von qwertz6561 ,

Hi,

Leider klappt es nicht. Habe auch die Range, WorksheetFunction nach meinen Anforderungen angepasst. Ich habe mal die Cells mit der WorksheetMatch Zeile getrennt angeschaut ob auch die richtige Zelle ausgewählt wird und es wurde die richtige Zelle ausgewählt.

Kommentar von qwertz6561 ,

Hat endlich geklappt :D

Ich habe bei 



Target.Font.Color = Sheets("pick lists").Cells(WorksheetFunction.Match(Target.Value, Sheets("Pick List").Range("C2:C32"), 0), 12).Font.Color



vergessen, weil von dort soll ja die Formatierung auf das Target angewendet werden. Man bin ich blöd :D Vielen dank nino

Hab dir den Stern gegeben :)

Kommentar von Ninombre ,

das habe ich gerade im Kommentar auch eingefügt. Ich hatte das Beispiel der Einfachheithalber in einem Tabellenblatt gebaut, da war es somit egal.

Du musst noch die Zeile beim Zugriff mit cells... anpassen. Match liefert das Ergebnis relativ zum angebenen Bereich: Dieser beginnt ja in C2, also ist ein Treffer in C2 = 1. Beim Zugriff mit cells würde das um eine Zeile falsch sein.

Im Zugriff steht auch noch die 12 als Spaltenangabe aus meinem Beispiel, die passt für Dich auch nicht.

Target.Font.Color = Sheets("pick lists").Cells(WorksheetFunction.Match(Target.Value, Sheets("Pick List").Range("C2:C32"), 0)+1, 3).Font.Color
Kommentar von qwertz6561 ,

Jup genau das hatte ich dann selber angepasst. Nochmals danke :) .

Antwort
von sternstefan, 29

Ich hoffe, der Code überlebt die Formatierung hier. :)
Die Werte für Range "C4:N33" und die Bedingungen musst du natürlich ersetzen.

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim rngC As Range
   If Not Intersect(Target, Range("C4:N33")) Is Nothing Then
      For Each rngC In Range("C4:N33")
         Select Case True
            Case Not IsNumeric(rngC.Value) Or Trim(rngC.Value) = ""
               rngC.Interior.ColorIndex = xlColorIndexNone  'keine Färbung
            Case rngC.Value < 50 And rngC.Value <= rngC.Offset(, -1).Value
               rngC.Interior.ColorIndex = 3 'rot
            Case rngC.Value < 50 And rngC.Value > rngC.Offset(, -1).Value
               rngC.Interior.ColorIndex = 45 'orange
            Case rngC.Value >= 50 And rngC.Value <= rngC.Offset(, -1).Value
               rngC.Interior.ColorIndex = 4 'grün
            Case rngC.Value >= 50 And rngC.Value > rngC.Offset(, -1).Value
               rngC.Interior.ColorIndex = 10 'dunkelgrün
         End Select
      Next
   End If
End Sub

Kommentar von qwertz6561 ,

rngC = Range wo ich meine Werte auswähle und welche dann überprüft wird und so formatiert wird wie ich es möchte, wenn ich es verstehe?

Und unten die Bedingungen.

Eine Frage, die PickList Werte habe ich in einem anderen Tabellen blatt, sagen wir mal sheets("Pick List").Range("c2:c32"). Und die haben eine bestimmte Formatierung. Genauso bezieht sich "rngC" auf diese Liste, aber übernimmt die Formatierung nicht. (Ohne Vba also einfach mit Bordmitteln also "Datenüberprüfung mit Bezug auf Liste".

Gibt es eine Methode im Sinne "von wenn Wert 1 aus referenzierte Pick list" dann soll er den Wert aus der anderen Liste pasten (denglisch lol) mit den Formaten also vielleicht irgendwas mit dieses xlpasteformats. Wie gesagt kenne mich jetzt nicht so gut aus.

Kommentar von sternstefan ,

rngC ist der Bereich, in dem du deine Picklist ausfüllst, nicht der Wertebereich! Wenn du von C4 bis C8 5 Felder hast, dann nimmst du "C4:C8".

In dem Beispiel wird davon ausgegangen, dass Zahlenwerte eingetragen werden. Wenn du Text hast, dann passt das natürlich nicht.

Kommentar von Iamiam ,

der Befehl heißt:...pastespecial (xlformats) oder, wenn Wert UND Formatierung übernommen werden sollen, einfach ...paste

Also die Zelle nicht mit dem erhaltenen Wert direkt füllen, sondern diesen erst in der Picklist suchen , dann kopieren und an richtiger Stelle einfügen. (anscheinend hast Du definierte Einzelwerte und keine Wertebereiche?)

Kommentar von qwertz6561 ,

Yep keine Zahlen sondern Abteilungsbezeichnungen pro Zelle (32x)

Kommentar von Iamiam ,

Auch Texte sind WERTE im Sinne von xl. eine Wertespanne wäre in so einem Fall Werkzeugausgabe...Zeiterfassung (so wie bei Behörden-Büros), aber das hast du ja nicht.

Keine passende Antwort gefunden?

Fragen Sie die Community