Office: Bedingte Formatierung Farbänderung Zellen

Hallo zusammen,

folgende Frage stellt sich mir zum Thema bedingte Formatierung:

Ich habe eine Jahrestabelle erstellt, wo ich u.a. eintrage, an welchem Tag des Jahres welcher Mitarbeiter frei hat (siehe Beispielmappe):
- vertikal stellen Spaltenpaare jeweils einen Tag dar (Spalten B und C den 01.01., Spalten D und E den 02.01., F und G den 03.01. usw.)
- horizontal sind die Namen der Mitarbeiter untereinander aufgelistet

Mein Anliegen ist es, dass wenn ich in die jeweils linke Spalte eines jeden Tages (also Spalten B, D, F usw.) einen bestimmten Wert (dfr2, dfr3, dfr4 usw.) eintrage, sich das Spaltenpaar in einer bestimmten Farbe ändert, dabei ist die dfr-Nummer egal, die Farbe bleibt die gleiche (grün).

Grundsätzlich erreiche ich das bei der bedingten Formatierung mit einer Oder- (Beispiel1) oder einer Suchen- (Beispiel2) Regelbeschreibung und Änderung des Anwendungsbereichs =$B$3:$C$3 bzw. =$B$11:$C$11

- Bei der Oder-Regel ist der Nachteil, dass ich jede einzelne dfr-Nummer in den Befehl schreiben muss (also max. 52)

- Bei der Suchen-Regel ist der Nachteil, dass nur die dfr-Nummern gefärbt werden, bei denen die 2 vorne steht, also 2, 20-29, für die anderen Zahlen müssen weitere Befehle erstellt werden.

Meine Fragen / Probleme:

- Kann man mit einem einfacheren Befehl die dfr2-dfr52 gemeinsam erfassen?

- ändere ich den Bereich "wird angewendet auf", um den Befehl auf die gesamte Arbeitsmappe zu erweitern, dann funktioniert es nur, wenn ich den Bereich nach unten auf weitere Zeilen erweitere (E:F). Erweitere ich den Bereich nach rechts auf weitere Spalten (G:H;I:J), dann wird die gesamte Zeile des markierten Bereichs gefärbt, nicht nur die beiden Spalten des jeweiligen Tages.
Den Befehl für jeden einzelnen Tag neu einzugeben kann bei 365 Tagen im Jahr keine Option sein.

- da unsere PCs auf der Arbeit nicht die leistungsstärksten sind noch die Frage, ob die Anzahl der bedingten Formatierungen auf eine ganze Jahrestabelle gesehen die Arbeitsprozesse (Eintragungen, Speichern, Drucken etc.) der Arbeitsmappe verlangsamen?!

Ich hoffe, ich konnte mich verständlich ausdrücken und jemand kann mir die richtige Vorgehensweise sagen.

Beste Grüße

 

schreibe Deine 52 Wert in einer Spalte und arbeite mit Zählenwen()>0

Der Name einer hochgeladenen Mappe wird im Beitrag automatisch angezeigt, sodass es bei Verwendung von aussagekräftigen Namen leichter fällt, sie später im Ablageordner wiederzufinden und sie gedanklich einem bestimmten Thema zuzuordnen. Namen wie Muster*, Test*, Mappe*, Beispiel*, Fehler*, Kalender*, UserForm* , Forum*, Excel* usw. sind so allgemein, dass eine Zuordnung zu einem Thema unmöglich gemacht wird.
Es sollte ein aussagekräftiger Name sein.

Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten ändern. Schaue Datei
http://hajo-excel.de/gepackt/fremd/Datei_verschluesseln.zip

Das ist nur meine Meinung zu dem Thema.

 

Hi,

erstelle deine bedingte Formatierung jeweils für 2 nebeneinanderliegende Spalten, also für B:C, D:E, F:G usw, dann kannst du dich mittels Formel TEIL() darauf beziehen, dass in der linken Spalte "dfr" steht, unabhängig von der nachfolgenden Ziffer:

Tabelle1

	A	B	C	D	E	F	G
2	Name/ Datum	'01.01.		'02.01.		'03.01.
3	Müller					dfr5
4	Meier			dfr2
5	Schulze	dfr4

die bedingte Formatierung Fülleffekte, Symbole, Datenbalken
werden in dieser Tabelle nicht dargestellt

verbundene Zellen

B2:C2

D2:E2

F2:G2

Bedingte Formatierung Haupttabelle 1
Wird angewendet auf	Nr. Bed. Regeltyp	Operator	Formel1	Formel2	Format Schrift Füll-farbe	Unterstrichen	Schrift- farbe	Muster	Muster-farbe	Typ	Bereich
$B$3:$C$5	01.Bed.: Formel ist		=TEIL($B3;1;3)="dfr"		33792					2	$B$3:$C$5
$D$3:$E$5	01.Bed.: Formel ist		=TEIL($D3;1;3)="dfr"		33792					2	$D$3:$E$5
$F$3:$G$5	01.Bed.: Formel ist		=TEIL($F3;1;3)="dfr"		33792					2	$F$3:$G$5

Bedingte Formatierung Haupttabelle 2					oberere/unterer Bereich
Wird angewendet auf	Nr. Bed.	Format Zelle	Anhalten	Auswahl	Anzeige	Anzahl	Durchschnitt	Typ	Bereich
$B$3:$C$5	01.Bed.		Falsch					2	$B$3:$C$5
$D$3:$E$5	01.Bed.		Falsch					2	$D$3:$E$5
$F$3:$G$5	01.Bed.		Falsch					2	$F$3:$G$5

Die Bedingungen wurden mit Excel-Version ab 2007 ausgelesen.

Füllfarben und Muster
Zelle	Rot	Grün	Blau	Color	Muster	Farbe
A2:A5, B2, D2, F2	217	217	217	14277081

Zellen mit Füllfarbe automatisch werden nicht dargestellt

http://excel-inn.de/dateien/vba_beispiele/tabellenanzeige_in_html_addin.zip

http://Hajo-Excel.de/tools.htm

Add-In-Version 25.24 einschl. 64 Bit

XHTML-Tabelle zur Darstellung in Foren, einschl. Funktion zum Zurücklesen in eine Excel-Tabelle

---

 

Guten Morgen Karin.

Vielen Dank für deine erneute Hilfe. Deine Formal hat soweit geklappt.
2 Probleme habe ich aber noch:

- mit der Formel wird ja jeder Eintrag, der mit "dfr" beginnt, entsprechend der Regel (dunkelgrün) gefärbt, unabhängig von der folgenden Zahl. Wünschenswert wäre allerdings, wenn dies erst ab dfr2 beginnt, da dfr1 eine separate Farbfüllung (neongrün) bekommen soll. Weitere Zusatzformatierungsregeln mit dem Eintrag dfr1, die ich ausprobiert habe, sorgen dafür, dass entweder nur das linke Feld neongrün wird und das rechte Feld dunkelgrün oder alle Felder die eine dfr1 im Namen haben werden neongrün, also auch dfr10-19

- ich habe nicht so ganz verstanden, wie ich nun die bedingten Formatierungen aus dem ersten Spaltenpaar (B:C) unkompliziert auf die anderen Spaltenpaare (D:E, F:G, usw.) übertragen kann. Erweitere ich einfach den Anwendungsbereich oder kopiere ich die Spalten, dann bleibt ja in der Formel die Bezugszelle ($B3) unverändert und die anderen Spalten beziehen sich auf diese. Muss ich in jedem einzelnen Spaltenpaar die Bezugszelle manuell ändern? Da dfr nicht die einzige mögliche bedingte Formatierung pro Zelle ist ( insgesamt sind es 10) wären das bei 365 Tagen ziemlich viele manuelle Änderungen

- ist es möglich (vielleicht auch mittels VBA), dass der Rahmenstrich zwischen den beiden Zellen aus jedem Spaltenpaar bei Färbung der Zellen verschwindet, ansonsten bleibt? Ändere ich das in der bedingten Formatierung, bezieht er das ja auf beide Zellen des Spaltenpaares und dann verschwinden entweder beide linke oder beide rechten Rahmenstriche.

 

Hi,

Problem 1 - wenn "dfr1" ausgeschlossen werden soll, dann muss die Formel so aussehen: =UND(TEIL($B3;1;3)="dfr";$B3<>"dfr1")

Problem 2 - um dir das Umbenennen der Spalten-Buchstaben für jedes Spaltenpaar zu ersparen, kannst du diese bedingte Formatierung komplett per VBA erstellen (Code in einem Standardmodul und von Hand ausführen):

Code:

Sub BedFormatErstellen()
    Dim intSpalte As Integer
    Dim intBed As Integer
    Dim strFormel As String
    For intSpalte = 2 To IIf(IsEmpty(Cells(3, Columns.Count)), _
        Cells(3, Columns.Count).End(xlToLeft).Column, Columns.Count) Step 2
        With Range(Cells(3, intSpalte), Cells(5, intSpalte + 1)) '<== Zeile 5 entsprechend deiner letzten Zeile anpassen!!
            .FormatConditions.Add Type:=xlExpression, Formula1:= _
                "=UND(TEIL(" & Cells(3, intSpalte).Address(False, True) & _
                ";1;3)=""dfr"";" & Cells(3, intSpalte).Address(False, True) & "<>""dfr1"")"
            With .FormatConditions(.FormatConditions.Count).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 5287936
                .TintAndShade = 0
            End With
        End With
    Next intSpalte
End Sub

Problem 3 - damit keine Linie zwischen den beiden Zellen angezeigt wird, kannst du folgenden Code im Codemodul des Tabellenblattes verwenden:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim intLetzte As Integer
    Dim intBedFormat  As Integer
    intLetzte = IIf(IsEmpty(Cells(3, Columns.Count)), _
        Cells(3, Columns.Count).End(xlToLeft).Column, Columns.Count)
    If Not Intersect(Target, Range(Cells(3, 2), Cells(5, intLetzte))) Is Nothing Then '<== Zeile 5 entsprechend deiner letzten Zeile anpassen!!
        If Target.Count = 1 Then
            If Target.Cells(1).Column Mod 2 = 0 Then
                For intBedFormat = 1 To Target.Cells(1).FormatConditions.Count
                    With Target.Cells(1).FormatConditions(intBedFormat)
                        If Left(.Formula1, 10) = "=UND(TEIL(" Then
                            If Target.DisplayFormat.Interior.Color = 5287936 Then
                                Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical).LineStyle = xlNone
                            Else
                                With Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical)
                                    .LineStyle = xlContinuous
                                    .ColorIndex = 0
                                    .TintAndShade = 0
                                    .Weight = xlThin
                                End With
                            End If
                        End If
                    End With
                Next intBedFormat
            End If
        End If
    End If
End Sub

Beachte dabei, dass dieser Code nur ausgeführt wird wenn nicht mehr als 1 Zelle ausgewählt wird.

---

 

Guten Morgen Karin.

Ich kann immer wieder nur ungläubig deine Codes bewundern, die du vermeintlich locker aus dem Ärmel schüttelst. Für mich einfach unglaublich. Vielen Dank schon mal für deine Zeit und Mühen.

Ich habe alles soweit übertragen, leider hakt es an irgendwelchen Stellen. Es wäre top, wenn du dir das mal anschauen könntest.
Von daher habe ich mal die entfremdete Datei angefügt, so wie sie tatsächlich aussieht, die Eintragungen sind in die Zeilen 7-58 zu machen. Alle benötigten Eintragungen und die dazugehörigen Farben habe ich als bedingte Formatierungen mit eingefügt.
Hier die Frage, ob man alle in einem VBA-Code zusammenfassen kann/sollte oder für jeden Eintrag einen separaten Code erstellen muss. Den Befehl für dfr1 musste ich anders gestalten, mit =TEIL hat es nicht geklappt.
Und die Frage, wo/wie ich mir die nummerische Codierung der Farben anzeigen lassen kann?

Grüße

 

Hi,

"leider hakt es an irgendwelchen Stellen" ist nicht gerade aussagekräftig um ein Problem finden zu können...

Deine Formeln für die bedingte Formatierung kannst du wesentlich vereinfachen: da wo der Zellinhalt einen bestimmten Wert enthalten soll kannst du völlig ohne TEIL()-Funktion auskommen - so wie du es für "dfr1" gemacht hast. Sind es mehrere Werte, dann kann man diese mittels der ODER()-Funktion zusammenfassen, z.B. so =ODER($E7="EFB";$E7="EZ") - du benötigst also nur 1 Formatierung und nicht 2, da beide dieselbe Farbe erhalten sollen. Dasselbe trifft auf "SU" und "U" zu.
Die Funktion TEIL() benötigst du nur für den Vergleich ob "dfr" mit einer Ziffer ab 2 aufwärts (und eben nicht dfr1) in der Zelle steht - das sieht dann so aus: =UND(TEIL($E7;1;3)="dfr";TEIL($E7;4;1)*1>1)

Die verschiedenen bedingten Formatierungen kann man quasi auf einen Ritt einfügen, nur muss man dabei eben die gewünschte Bedingung und die gewünschte Füllfarbe entsprechend anpassen:

Code:

Option Explicit

Sub BedFormatErstellen()
    Dim intSpalte As Integer
    Dim intBed As Integer
    Dim strFormel As String
    For intSpalte = 7 To IIf(IsEmpty(Cells(5, Columns.Count)), _
        Cells(5, Columns.Count).End(xlToLeft).Column, Columns.Count) Step 2
        With Range(Cells(7, intSpalte), Cells(58, intSpalte + 1))
            '1. $E7="dfr1"
            .FormatConditions.Add Type:=xlExpression, Formula1:= _
                "=" & Cells(7, intSpalte).Address(False, True) & "=""dfr1"""
            With .FormatConditions(.FormatConditions.Count).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 5287936    '<== Farbnummer anpassen
                .TintAndShade = 0
            End With
            '2. =$E7="E"
            .FormatConditions.Add Type:=xlExpression, Formula1:= _
                "=" & Cells(7, intSpalte).Address(False, True) & "=""E"""
            With .FormatConditions(.FormatConditions.Count).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 5287936    '<== Farbnummer anpassen
                .TintAndShade = 0
            End With
            '3. =ODER($E7="EFB";$E7="EZ")
            .FormatConditions.Add Type:=xlExpression, Formula1:= _
                "=ODER(" & Cells(7, intSpalte).Address(False, True) & "=""EFB"";" & Cells(7, intSpalte).Address(False, True) & "=""EZ"")"
            With .FormatConditions(.FormatConditions.Count).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 5287936    '<== Farbnummer anpassen
                .TintAndShade = 0
            End With
            '4. =$E7="LEB"
            .FormatConditions.Add Type:=xlExpression, Formula1:= _
                "=" & Cells(7, intSpalte).Address(False, True) & "=""LEB"""
            With .FormatConditions(.FormatConditions.Count).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 5287936    '<== Farbnummer anpassen
                .TintAndShade = 0
            End With
            '5. =$E7="abg"
            .FormatConditions.Add Type:=xlExpression, Formula1:= _
                "=" & Cells(7, intSpalte).Address(False, True) & "=""abg"""
            With .FormatConditions(.FormatConditions.Count).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 5287936    '<== Farbnummer anpassen
                .TintAndShade = 0
            End With
            '6. =ODER($E7="SU";$E7="U")
            .FormatConditions.Add Type:=xlExpression, Formula1:= _
                "=ODER(" & Cells(7, intSpalte).Address(False, True) & "=""SU"";" & Cells(7, intSpalte).Address(False, True) & "=""U"")"
            With .FormatConditions(.FormatConditions.Count).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 5287936    '<== Farbnummer anpassen
                .TintAndShade = 0
            End With
            '7. =$E7="Q"
            .FormatConditions.Add Type:=xlExpression, Formula1:= _
                "=" & Cells(7, intSpalte).Address(False, True) & "=""Q"""
            With .FormatConditions(.FormatConditions.Count).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 5287936    '<== Farbnummer anpassen
                .TintAndShade = 0
            End With
            '8. =$E7="kr"
            .FormatConditions.Add Type:=xlExpression, Formula1:= _
                "=" & Cells(7, intSpalte).Address(False, True) & "=""kr"""
            With .FormatConditions(.FormatConditions.Count).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 5287936    '<== Farbnummer anpassen
                .TintAndShade = 0
            End With
            '9 =UND(TEIL($E7;1;3)="dfr";TEIL($E7;4;1)*1>1)
            .FormatConditions.Add Type:=xlExpression, Formula1:= _
                "=UND(TEIL(" & Cells(7, intSpalte).Address(False, True) & ";1;3)=""dfr"";TEIL(" & Cells(7, intSpalte).Address(False, True) & ";4;1)*1>1)"
            With .FormatConditions(.FormatConditions.Count).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 5287936    '<== Farbnummer anpassen
                .TintAndShade = 0
            End With
        End With
    Next intSpalte
End Sub

Die letzte belegte Spalte kann nicht in Zeile 7 ermittelt werden, da in deiner jetzigen Mappe diese Zeile leer ist - dazu muss Zeile 5 herangezogen werden. Außerdem muss die Schleife mit einer anderen Spaltennummer beginnen.
Die Farbnummern musst du im Code selbstverständlich anpassen.

Die Farbnummer einer normal gefärbten Zelle kann man sich problemlos per VBA anzeigen lassen: färbe eine Zelle von Hand mit der gewünschten Farbe, setze den Cursor in diese Zelle und führe folgendes Makro aus - damit wird die Farbnummer in die betreffende Zelle geschrieben:

Code:

Sub Farbnummer()
    ActiveCell = ActiveCell.Interior.Color
End Sub

Für die bedingte Formattierung ist der Code komplizierter, aber da die Farbnummern identisch sind reicht diese einfache Variante.

Der Code im Codemodul des Tabellenblattes muss aufgrund der veränderten Situation in deinem Tabellenaufbau ebenfalls geändert werden:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim intLetzte As Integer
    Dim intBedFormat  As Integer
    intLetzte = IIf(IsEmpty(Cells(5, Columns.Count)), _
        Cells(5, Columns.Count).End(xlToLeft).Column, Columns.Count)
    If Target.Column > 4 And Target.Column < intLetzte Then
        If Target.Row > 6 And Target.Row < 59 Then
            If Target.Count = 1 Then
                If Target.Column Mod 2 <> 0 Then
                    For intBedFormat = 1 To Target.Cells(1).FormatConditions.Count
                        With Target.FormatConditions(intBedFormat)
                            If Target.DisplayFormat.Interior.ColorIndex <> 15 Then
                                Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical).LineStyle = xlNone
                                Exit For
                            Else
                                With Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical)
                                    .LineStyle = xlContinuous
                                    .ColorIndex = 0
                                    .TintAndShade = 0
                                    .Weight = xlThin
                                    Exit For
                                End With
                            End If
                        End With
                    Next intBedFormat
                End If
            End If
        End If
    End If
End Sub

---

 

Guten Morgen.

Sorry für die unpräzise Angabe, du hast vollkommen recht:

- der Code zum Entfernen des Mittelrahmens funktioniert ohne Probleme. Färben sich die Zellen, verschwindet auch der Rahmen, so wie er soll

- den Code für "dfr1" musste ich leicht ändern und die Endung aus deinem vorherigen Post verwenden (Endung ;$E7<>"dfr1").Bei der Endung ;TEIL($E7;4;1)*1>1) färben sich die Nummern 10-19 analog zu dfr1

- das Einfärben der Zellen funktioniert allerdings nur mit der normalen Funktion Bedingte Formatierung, über VBA leider nicht, obwohl ich den Code so übernommen und die Farbnummern angepasst habe. Den Grund dafür kann ich leider nicht finden. Die Tabelle mit dem angepassten Code habe ich noch mal angehangen

- Bei den Einträgen "EZ" und "EFB" soll sich ja zusätzlich zur Färbung der Zelle (schwarz) auch die Schriftfarbe in weiß ändern. Muss da der entsprechende Code noch irgendwie angepasst werden?!

Danke und liebe Grüße

 

Selbstverständlich funktioniert nur die "normale" Bedingte Formatierung - wozu soll denn zusätzlich noch eine Färbung per Makro geben??? Das Makro ist nur dazu da, das Eintragen der Bedingten Formatierung in die paarweisen Spalten zu erleichtern - du hattest ja gefragt, ob man das Übertragen der bedingten Formatierung in die anderen Spalten vereinfachen kann. Das Makro erstellt für alle paarweisen Spalten jede der 9 Bedingten Formatierungen - einmal ausgeführt muss es nicht mehr benutzt werden.
Im Code musst du allerdings in der Zeile

Code:

    For intSpalte = 7 To IIf(IsEmpty(Cells(5, Columns.Count)), _

die 7 in 5 ändern - ich war davon ausgegangen, dass es in Spalte E:F die Bedingte Formatierung bereits gibt (so wie in deiner vorhergehenden Mappe), weshalb diese beiden Spalten ausgeschlossen werden mussten. Nun hast du diese Bedingten Formatierungen jedoch gelöscht - folglich muss die Schleife in Spalte E und nicht erst in Spalte G beginnen.

Für das Anpassen der Schriftfarbe muss für die betreffende Formatierung ein Zusatz ergänzt werden, sodass der Code an dieser stelle so aussehen muss:

Code:

            '3. =ODER($E7="EFB";$E7="EZ")
            .FormatConditions.Add Type:=xlExpression, Formula1:= _
                "=ODER(" & Cells(7, intSpalte).Address(False, True) & "=""EFB"";" & Cells(7, intSpalte).Address(False, True) & "=""EZ"")"
            With .FormatConditions(.FormatConditions.Count).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 0
                .TintAndShade = 0
            End With
            ' schriftfarbe Weiß
            With .FormatConditions(.FormatConditions.Count).Font
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With

---

 

Ok, jetzt habe ich das Prinzip des Codes verstanden.
Ich habe die bedingten Formatierungen wieder in der Spalte E:F erstellt und den Code ergänzt, nichtsdestotrotz will eine Übernahme der Formatierungen auf die anderen Spaltenpaaren nicht funktionieren.

 

Selbstverständlich funktioniert die Erstellung der Bedingten Formatierung für ALLE Spalten - du musst nur lange Zeit warten und darfst Excel nicht gewaltsam schließen weil du glaubst es sei abgestürzt, denn es dauert eben seine Zeit bis der Code durchgelaufen ist, schließlich handelt es sich um mehr als 700!!! Spalten. Solch viele Bedingte Formatierungen belasten die Mappe aber starkt, was ihre Performance/Handhabung betrifft. Dass es so viele Spalten sein werden, war anfangs ja nicht abzusehen, sonst hätte ich gleich empfohlen, die Färbung stattdessen generell mit VBA zu realisieren. Vergiss also das Makro und verwende folgendsen Code im Codemodul des Tabellenblattes:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim intLetzte As Integer
    intLetzte = IIf(IsEmpty(Cells(5, Columns.Count)), _
        Cells(5, Columns.Count).End(xlToLeft).Column, Columns.Count)
    If Target.Column > 4 And Target.Column < intLetzte Then
        If Target.Row > 6 And Target.Row < 59 Then
            If Target.Count = 1 Then
                If Target.Column Mod 2 <> 0 Then
                    Target.Font.ColorIndex = xlAutomatic
                    Select Case Target
                        Case "dfr1"
                            Range(Target, Target.Offset(0, 1)).Interior.Color = 65280
                            Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical).LineStyle = xlNone
                        Case "dfr2", "dfr3", "dfr4", "dfr5"                   '<== hier in dieser Zeile alle dfr ergänzen!!
                            Range(Target, Target.Offset(0, 1)).Interior.Color = 35584
                            Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical).LineStyle = xlNone
                        Case "E"
                            Range(Target, Target.Offset(0, 1)).Interior.Color = 16711935
                        Case "EFB", "EZ"
                            Range(Target, Target.Offset(0, 1)).Interior.Color = 0
                            Target.Font.Color = vbWhite
                            Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical).LineStyle = xlNone
                        Case "LEB"
                            Range(Target, Target.Offset(0, 1)).Interior.Color = 1137094
                            Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical).LineStyle = xlNone
                        Case "abg"
                            Range(Target, Target.Offset(0, 1)).Interior.Color = 65535
                            Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical).LineStyle = xlNone
                        Case "SU", "U"
                            Range(Target, Target.Offset(0, 1)).Interior.Color = 12611584
                            Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical).LineStyle = xlNone
                        Case "Q"
                            Range(Target, Target.Offset(0, 1)).Interior.Color = 49407
                            Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical).LineStyle = xlNone
                        Case "kr", "krv"
                            Range(Target, Target.Offset(0, 1)).Interior.Color = 255
                            Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical).LineStyle = xlNone
                        Case Else
                            Target.Interior.Color = 12566463
                            Target.Offset(0, 1).Interior.ColorIndex = xlNone
                            Target.Font.ColorIndex = xlAutomatic
                            With Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlThin
                            End With
                    End Select
                End If
            End If
        End If
    End If
End Sub

Also bitte das nächtemal gleich von Beginn an darauf hinweisen, dass es sich um außerordentlich viele Spalten handelt, dann hätte man sich Zeit und Arbeit sparen können. Der Hinweis in deinem Eröffnungsbeitrag, dass eure Rechner nicht die schnellsten sind war zwar gut gemeint, aber eben nicht hilfreich, weil das viel bedeuten kann und deine zuerst hochgeladene Mappe das tatsächliche Ausmaß nicht erahnen lies.

---

 

Hi,

mit einer geschickten Formulierung der Formeln, kann man die Anzahl der benötigten bed.Form, auf 9 reduzieren! Man braucht dann keine 742/2 * 9 = 3389 bed.Form. Damit erübrigt sich der VBA-Code zum Erstellen dieser bed.Form.

Dazu einfach überall in den Formeln $E7 durch INDEX(D7:E7;1+REST(SPALTE();2)) ersetzen. Dann kann "wird angewendet auf" den ganzen Bereich umfassen =$E$7:$ABR$58

Wenn du dann noch die bed.Form für Neongrün ganz nach oben setzt, kann man bei der Formel für dunkelgrün auf das UND() verzichten. Außerdem würde ich dort nicht TEIL() sondern LINKS() verwenden. Aber das ist Geschmacksache.

Eventuell hilft es auch noch, jeweils den Haken bei Anhalten zu setzen. Dann werden, sobald eine Bedingung zutrifft, die weiteren Bedingungen (also die weiter unten) für diese Zelle nicht mehr geprüft.

Ich habe dir das alles mal in deine Datei eingebaut.

 

Hallo Karin, Hallo HKindler.

Vielen Dank für eure Hilfe, Zeit und Kreativität. Beide Alternativen funktionieren sehr gut und wie benötigt.
Und sorry, wenn ich euch durch meine unpräzisen Angaben mehr Arbeit als nötig bereitet habe.
Ich verspreche, zukünftig genauer das Problem zu beschreiben und eine anonymisierte Originalmappe einzustellen, um den Umfang der Anforderungen besser einschätzen zu können.

Viele Grüße

 

Hallo Ihr Lieben,

beim rumprobieren mit euren Lösungen bin ich auf einen Gedanken gekommen, welcher mir die Arbeit noch mal wesentlich erleichtern würde. Vielleicht gibt es dafür ja auch eine praktikable Lösung?!

Karin, ich habe deinen letzten Code als Grundlage zum Einfärben der Zellen und Entfernen des Mittelstriches genutzt, dabei habe ich die Einträge "E" und "LEB" rausgenommen.

Diese beiden Einträge habe ich als bedingte Formatierung gesetzt, damit sich nur die linke Zelle färbt und der Mittelstrich erhalten bleibt. Meine Idee ist nun, dass wenn ich in die jeweilige Zelle der Zeile 6 einen der folgenden Einträge mache, automatisch die jeweils linken darunterliegenden Zellen der Zeilen 7 bis 52 der jeweiligen Spalte folgendermaßen befüllt werden:
- beim Eintragen "EXTRA" in jede Zelle ein "E"
- beim Eintrag "LEB in jede Zelle ein "LEB"
- beim Eintrag "Früh", "Spät" oder "Tag" in jede Zelle jeweils ein "F", "S" oder "T"
- bei keinem oder anderem als der beschriebenen Einträge jede Zelle leer

Die genannten Einträge sollen sich gegenseitig automatisch überschreiben, sobald eine Änderung in Zeile 6 erfolgt, allerdings dürfen keine Zellen befüllt werden, in denen sich bereits ein Eintrag aus dem bestehenden Code (dfr1, dfr2-dfr52, U, SU, Q, kr, krV, EZ, EFB, abg) befindet. Diese Eintragungen sollen erhalten bleiben.

Zusammenfassend gesagt, der benötigte Code muss erkennen:
- welche darunterliegende linke Zelle der Spalte leer ist oder sich der Eintrag E, LEB, F, S, T befindet und wissen, dass er diese Zelle bei Änderung in Zeile 6 entsprechend befüllen / überschreiben soll
- er die Finger von den Zellen lassen soll, in denen sich bereits die Einträge dfr1, dfr2 - dfr52, U, SU, Q, kr, krV, EZ, EFB, abg befinden

Der Code muss sich wie bereits der bestehende Code auf das gesamte Arbeitsblatt beziehen lassen können.

Ich hoffe, ich konnte mein Anliegen treffend darstellen. Die angehängte Arbeitsmappe stellt meine Thematik noch mal praktisch dar.
Ich freue mich schon auf eure kreativen Lösungen.

Grüße

 

Hi,

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim intLetzte As Integer
    Dim rngZelle As Range
    intLetzte = IIf(IsEmpty(Cells(5, Columns.Count)), _
        Cells(5, Columns.Count).End(xlToLeft).Column, Columns.Count)
    If Target.Column > 4 And Target.Column < intLetzte Then
        If Target.Row > 6 And Target.Row < 59 Then
            If Target.Count = 1 Then
                If Target.Column Mod 2 <> 0 Then
                    Target.Font.ColorIndex = xlAutomatic
                    Select Case Target
                        Case "dfr1"
                            Range(Target, Target.Offset(0, 1)).Interior.Color = 65280
                            Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical).LineStyle = xlNone
                        Case "dfr2", "dfr3", "dfr4", "dfr5", "dfr6", "dfr7", "dfr8", "dfr9", "dfr10", "dfr11", "dfr12", "dfr13", "dfr14", "dfr15", "dfr16", "dfr17", "dfr18", "dfr19", "dfr20", "dfr21", "dfr22", "dfr23", "dfr24", "dfr25", "dfr26", "dfr27", "dfr28", "dfr29", "dfr30", "dfr31", "dfr32", "dfr33", "dfr34", "dfr35", "dfr36", "dfr37", "dfr38", "dfr39", "dfr40", "dfr41", "dfr42", "dfr43", "dfr44", "dfr45", "dfr46", "dfr47", "dfr48", "dfr49", "dfr50", "dfr51", "dfr52", "dfr53"
                            Range(Target, Target.Offset(0, 1)).Interior.Color = 35584
                            Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical).LineStyle = xlNone
                        Case "EFB", "EZ"
                            Range(Target, Target.Offset(0, 1)).Interior.Color = 0
                            Target.Font.Color = vbWhite
                            Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical).LineStyle = xlNone
                        Case "abg"
                            Range(Target, Target.Offset(0, 1)).Interior.Color = 65535
                            Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical).LineStyle = xlNone
                        Case "SU", "U"
                            Range(Target, Target.Offset(0, 1)).Interior.Color = 12611584
                            Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical).LineStyle = xlNone
                        Case "Q"
                            Range(Target, Target.Offset(0, 1)).Interior.Color = 49407
                            Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical).LineStyle = xlNone
                        Case "kr", "krV"
                            Range(Target, Target.Offset(0, 1)).Interior.Color = 255
                            Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical).LineStyle = xlNone
                        Case Else
                            Target.Interior.Color = 12566463
                            Target.Offset(0, 1).Interior.ColorIndex = xlNone
                            Target.Font.ColorIndex = xlAutomatic
                            With Range(Target, Target.Offset(0, 1)).Borders(xlInsideVertical)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlThin
                            End With
                    End Select
                End If
            End If
        ' Codeergänzung ab hier
        ElseIf Target.Row = 6 Then
            For Each rngZelle In Range(Cells(7, Target.Column), Cells(58, Target.Column))
                If Left(rngZelle, 3) = "dfr" Or rngZelle = "Q" Or rngZelle = "abg" Or rngZelle = "kr" Or rngZelle = "krV" Or rngZelle = "EZ" _
                    Or rngZelle = "EFB" Or rngZelle = "SU" Or rngZelle = "U" Then
                Else
                    Application.EnableEvents = False
                    Select Case Target
                        Case "EXTRA"
                            rngZelle = "E"
                        Case "LEB"
                            rngZelle = Target
                        Case "Früh", "Spät", "Tag"
                            rngZelle = Left(Target, 1)
                    End Select
                    Application.EnableEvents = True
                End If
            Next rngZelle
        End If
    End If
Errorhandler:
    Application.EnableEvents = True
End Sub

---