Zellen mit Macro einfärben Bedingt formatierung greist nicht!
Und ich schon wieder,
kann man mit einem Makro Zellen einfärben?
Ich habe 8 unterschiedliche Abfragen, und somit greift die "bedingt formatierung" nicht (max. 3 Abfragen)
Also 8 Abfrage Kriterien, und 8 verschiedene Farben.
Wie wurde der Code dafür aussehen?
Ein Beispiel:
Wenn D3 I-Punkt = grün
Wenn E3 Büro =orange
Wenn F3 Verpackung = blau
usw.
Kann man in der Abfrage, Zellwert suchen, diesen einfärben und die Zelle vor dem gefundenem Wert mit einfärben?
Bsp.
Wochenendabfrage
Wenn C3 Sa = C3 & B3 grau
Wäre toll wenn mir da jemand weiter helfen könnte.
Danke euch und MfG Benjä
Antwort schreiben
Antwort 2 von BenjaminM vom 01.08.2020, 07:53 Options
Hallo Hajo,
ich hab das Problem, dass ich die Sachen auf der Arbeit mache, und ich von dort nicht alles abrufen kann.(sprich: ich habe nicht auf alle Websites Zugriff)
So, nun hast du mir nen super Link geschickt, und ich kann mir die HP anschauen, jedoch sofern es an die Beispiele geht ist bei mir Schluß.
Deshalb habe ich auch hier im Forum gefragt, und gehofft das mir jemand hier den Code posten kann.
Wenn es dir keinen Umstand macht....?
Danke Benjä
Antwort 3 von Hajo_Zi vom 01.08.2020, 09:39 Options
Hallo Benjamin,
ich habe den Code auf meinem Homerechner und das wird erst was nach 18:00 Uhr.
Gruß Hajo
Antwort 5 von Hajo_Zi vom 01.08.2020, 18:13 OptionsLösung
Hallo Benjamin,
jetzt hat er den Beitrag vom morgen wiederholt.
Obwohl kein Intresse besteht hier der Code.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'**************************************************
'* H. Ziplies *
'* 10.02.07 *
'* erstellt von Hajo.Ziplies@web.de *
'* http://Hajo-Excel.de/ *
'**************************************************
' Füllfarbe
' für Schrift RaZelle.Font.ColorIndex
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("L22:M39, O21:O26")
' noch mehr Bereiche
' Set RaBereich = Union(Range("C11:AG11 , C13:AG13, C15:AG15 , C17:AG17 , C19:AG19 , C21:AG21 , C27:AE27 , C29:AE29, C31:AE31, C33:AE33"), _
' Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47 , C49:AG49 ,C51:AG51 , C53:AG53 , C59:AF59 , C61:AF61 , C63:AF63 , C65:AF65"), _
' Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79 , C81:AG81 , C83:AG83 , C85:AG85 ,C91:AF91 , C93:AF93 , C95:AF95 , C97:AF97"), _
' Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109 , C111:AG111 , C113:AG113 , C115:AG115 , C117:AG117 , C123:AG123 , C125:AG125"), _
' Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133 , C139:AF139 , C141:AF141 , C143:AF143 , C145:AF145 , C147:AF147 , C149:AF149"), _
' Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161 , C163:AG163 , C165:AG165 , C171:AF171 , C173:AF173 , C175:AF175 , C177:AF177 "), _
' Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189 , C191:AG191 , C193:AG193 , C195:AG195 , C197:AG197"))
' ab Vesion XP braucht der Schutz nicht aufgehoben werden
' Formatierung bei Schutz kann über Dialog Schutz eingestellt werden
' ActiveSheet.Unprotect ("Passwort")
' Zelle die in dem Bereich liegen auf die Varible schreiben
' damit werden nur noch die Zellen bearbeitet die im vorgegeben Bereich liegen
' jede Zelladresse ist einzeln angegeben
Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If RaBereich Is Nothing Then Exit Sub
For Each RaZelle In RaBereich
With RaZelle
Select Case UCase(.Value) ' UMWANDLUNG DER Eingabe in Großbuchstaben
Case "1"
.Interior.ColorIndex = 1
' schwarz
.Font.ColorIndex = 2
' Schriftfarbe weiß
'.NumberFormat = "General"
' Zellenformat Standard
Case "2"
.Interior.ColorIndex = 6
' weiß
.Font.ColorIndex = 0
' Schriftfarbe automatisch
'.NumberFormat = "General"
' Zellenformat Standard
Case "3"
.Interior.ColorIndex = 3
' rot
.Font.ColorIndex = 2
' Schriftfarbe Weiß
'.NumberFormat = ";;;"
' nicht sichtbar
Case "4"
.Interior.ColorIndex = 4
' grün
.Font.ColorIndex = 0
' Schriftfarbe automatisch
'.NumberFormat = "General"
' Zellenformat Standard
Case "KLAUS"
.Interior.ColorIndex = 5
' blau
.Font.ColorIndex = 15
' Schriftfarbe automatisch
'.NumberFormat = "General"
' Zellenformat Standard
Case Else
.Interior.ColorIndex = xlNone
' Keine
.Font.ColorIndex = 0
' Schriftfarbe automatisch
'.NumberFormat = "General"
' Zellenformat Standard
End Select
End With
Next RaZelle
' ActiveSheet.protect ("Passwort")
Set RaBereich = Nothing
End Sub
Gruß Hajo
Antwort 6 von BenjaminM vom 04.08.2020, 09:14 Options
HAllo Hajo!
Danke für deinen Code, aber ich bin VBA laie!!
Ich kann nicht viel damit anfangen!
Kannst du mir deinen Code erklären, oder einen Codeausschnitt geben den ich anpassen und danach erweitern kann? (Kopieren)
MfG Benjä
Antwort 7 von Hajo_Zi vom 04.08.2020, 09:31 Options
Hallo Benja,
es stehen nun schon vioele Kommentare im Code. Der Code gehört unter die Tabelle.
Gruß Hajo
Antwort 8 von BenjaminM vom 04.08.2020, 13:34 Options
Danke für deine Mühe!
Ich habe mich damit auch auseinandergesetzt!
Jedoch funzt das bei mit nicht!
Ich hab Excel97!
Und die Werte(Worte) die ich Abfrage, werden aus einer Master-Tabelle gezogen, kann es damit zusammenhängen, das dass nicht funzt?
Ich habe den Zellbereich angepasst:
Set RaBereich = Range("D3:I33")
und bei Case meine Werte eingefügt:
Case "Büro"
Case "I-Punkt"
usw.
Oder ist das falsch??
Danke und MfG Benjä
Antwort 9 von Hajo_Zi vom 04.08.2020, 13:37 Options
Hallo Benja,
sind es bei Dir vielleicht keine Eingaben sondern Formeln?
Gruß hajo
Antwort 10 von BenjaminM vom 04.08.2020, 14:11 Options
Jupp!
Bsp.
=WENN(Master!J39="B";Master!$BE$23;
WENN(Master!J39="A";Master!$BE$24;
WENN(Master!J39="S";Master!$BE$22;
WENN(Master!J39=1;Master!$BE$14;
WENN(Master!J39=2;Master!$BE$15;
WENN(Master!J39=3;Master!$BE$16;
WENN(Master!J39=4;Master!$BE$17;"")))))))
&WENN(Master!J39=5;Master!$BE$18;
WENN(Master!J39=6;Master!$BE$19;
WENN(Master!J39=7;Master!$BE$20;
WENN(Master!J39=8;Master!$BE$21;""))))
Gruß Benjä
Antwort 11 von Hajo_Zi vom 04.08.2020, 15:57 Options
Hallo Benja,
das sind Formel.
Option Explicit
Private Sub Worksheet_Calculate()
'**************************************************
'* H. Ziplies *
'* 19.07.03 *
'* erstellt von Hajo.Ziplies@web.de *
'* http://Hajo-Excel.de/ *
'**************************************************
' diese Variante kostet natürlich Rechenleistung
' da bei jeder Eingabe der Bereich Formatiert wird
' HINTERGRUND
' für Schrift RaZelle.Font.ColorIndex
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("B8:C25, D7:D12")
' noch mehr Bereiche
' Set RaBereich = Union(Range("C7:I26"), Range("L7:R26"), Range("U7:AA26"), Range("AD7:AJ26"))
' ab Vesion XP braucht der Schutz nicht aufgehoben werden
' Formatierung bei Schutz kann über Dialog Schutz eingestellt werden
' ActiveSheet.Unprotect
For Each RaZelle In RaBereich
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
Select Case RaZelle.Value
Case "1"
' schwarz
RaZelle.Interior.ColorIndex = 15
Case "2"
' gelb
RaZelle.Interior.ColorIndex = 6
Case "3"
' rot
RaZelle.Interior.ColorIndex = 3
Case "4"
' grün
RaZelle.Interior.ColorIndex = 4
Case Else
' Keine
RaZelle.Interior.ColorIndex = xlNone
End Select
End If
Next RaZelle
' ActiveSheet.protect
Set RaBereich = Nothing
End Sub
Gruß hajo
Antwort 12 von BenjaminM vom 04.08.2020, 16:46 Options
Hallo,
Jetzt bekomme ich einen Laufzeit Fehler!
Laufzeitfehler 1004
"Die ColorIndex-Eigenschaften des Intterior-Objektes kann nicht festgelegt werden."Was tun?
Er makiert mir im VBA Editor
Die Zeile
RaZelle.Interior.ColorIndex = xlNone
Mach ich was falsch?
Hier mal der Code mit meinen Modi´s
Option Explicit
Private Sub Worksheet_Calculate()
'**************************************************
'* H. Ziplies *
'* 19.07.03 *
'* erstellt von Hajo.Ziplies@web.de *
'* http://Hajo-Excel.de/ *
'**************************************************
' diese Variante kostet natürlich Rechenleistung
' da bei jeder Eingabe der Bereich Formatiert wird
' HINTERGRUND
' für Schrift RaZelle.Font.ColorIndex
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("C3:C33, D3:D33")
' noch mehr Bereiche
' Set RaBereich = Union(Range("C7:I26"), Range("L7:R26"), Range("U7:AA26"), Range("AD7:AJ26"))
' ab Vesion XP braucht der Schutz nicht aufgehoben werden
' Formatierung bei Schutz kann über Dialog Schutz eingestellt werden
' ActiveSheet.Unprotect
For Each RaZelle In RaBereich
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
Select Case RaZelle.Value
Case "Büro"
' schwarz
RaZelle.Interior.ColorIndex = 15
Case "I-Punkt"
' gelb
RaZelle.Interior.ColorIndex = 6
Case "Verpackung"
' rot
RaZelle.Interior.ColorIndex = 3
Case "Kannenraum"
' grün
RaZelle.Interior.ColorIndex = 4
Case Else
' Keine
RaZelle.Interior.ColorIndex = xlNone
End Select
End If
Next RaZelle
' ActiveSheet.protect
Set RaBereich = Nothing
End Sub
oder hab ich da jetzt im RaBereich etwas versaubeutelt?
Danke für eure Geduld
MfG Benjä
Antwort 13 von Hajo_Zi vom 04.08.2020, 19:21 Options
Hallo Benjä,
kein Ansatz, ich sehe Deine Datei nicht. Warum sollte ich das nachbauen, die Zeit hast Du schon investiert zur Erstellung.
Gruß Hajo
Antwort 15 von Hajo_Zi vom 04.08.2020, 20:37 Options
Hallo Benjä,
Deine Tabelle ist geschützt.
Du mußt das Zeichjen ' vor
ActiveSheet.Unprotect
ActiveSheet.Protect
entfernen
Gruß Hajo
Antwort 16 von BenjaminM vom 05.08.2020, 10:30 Options
Hallo Hajo!
Ich danke dir für die schnellen Antworten, ich habe jetzt das Makro angepasst, und das läuft auch, wenn ich es an ein Tabellenblatt anhänge.
Wenn ich es jedoch an alle 12 (Monate) hänge, kommt der gleiche Fehlerwie in Antwort12
Laufzeitfehler 1004
"Die ColorIndex-Eigenschaften des Intterior-Objektes kann nicht festgelegt werden."hängt das jetzt mit dem Befehl
Activesheet.Protect
zusammen?
Denn es funzt auf alles Tabellenblättern, nur das 12x ie Fehlermeldung angezeigt wird.
Hier noch mal das Ansatz mit Modi:
http://rapidshare.com/files/134959809/Der_Ansatz_mit_Modi.xlsDanke & MfG Benjä
Antwort 17 von Hajo_Zi vom 05.08.2020, 10:44 Options
HalloBenjä,
Du hast ja meine HP besucht, damit dürfte Dir klar sein das der Beiotrag für mich erledui#igt ist. Siehe auch hier http://hajo-excel.de/copyright.htm
Gruß Hajo