Change Ereignis beim Befüllen von Zellen mit Formeln funktioniert nicht

[Arni49]

Hallo
Wie setze ich das am besten um? Kannst Du mir da weiterhelfen?
Gruß

[schauan]

Hallöchen,

Vor den Cases ermittelst Du die Spalte und bei den Cases fügst Du das Farbe setzen auf TermineTagesaktuell hinzu, z.B. so

Code:

icol = 2 + (RaZelle.Column - 2) Mod 6 - (6 * (((RaZelle.Column - 2) Mod 6) = 0))

Case Sheets("Parameter").Range("E1").Value  'Für Leer Zellen
    .Interior.ColorIndex = Sheets("Parameter").Range("f1")          ' Füllfarbe
    .Font.ColorIndex = Sheets("Parameter").Range("g1")
    With Sheets("TermineTagesaktuell").Cells(RaZelle.Row, icol)
        .Interior.ColorIndex = Sheets("Parameter").Range("f1")          ' Füllfarbe
        .Font.ColorIndex = Sheets("Parameter").Range("g1")
    End With
Case Sheets("Parameter").Range("E3").Value  'PKG20

Ich gehe davon aus, dass auf TermineTagesaktuell nur ein Tag ausgegeben wird.

Das würde aber auch bedeuten, wenn Du beim Ausfüllen vom 1.12. bist und machst dann gleich was beim 2.12., dass dir auf TermineTagesaktuell die Farben nach dem 2.12. gesetzt werden.
Das ist jetzt eine Lösung für Änderungen bei Eingabe in einem Monatsblatt. Willst Du z.B. auf TermineTagesaktuell durch Änderung des Datums in A1 einen anderen Tag holen, musst Du das entsprechend programmieren.

[Arni49]

Hallo,

vorneweck erstmal Danke.

 TermineTagesaktuell A1 ist immer der aktuelle Tag(also der 1.12) unabhängig von den anderen Eintragungen z.B. am 2.12, sollen nur die Daten vom 1.12.(Heute())  angezeigt und eingefärbt werden, eine Datumsänderung in A1 ist nicht vorgesehen, wenn Du aber Lust hast würde mich diese Variante auch interessieren.

Grüße

[schauan]

Hallöchen,

erst noch ein Hinweis zum anderen Code. Die Ermittlung von iCol gehört vor Select Case.

Hier ein Ansatz. Du kannst im WorkSheet_Change von TermineTagesaktuell nach der ersten eine zweite Prüfung einbauen.
Wenn A1 geändert wird, dann werden aus dem Datumsbereich das Tages auf dem Monatsblatt alle Formate übertragen.

Code:

If Target.Address = "$A$1" Then
  Dim icol As Integer
  'Startspalte berechnen
  icol = 6 * Format(Cells(1, 1).Value, "D") - 3
  'Formate von Zeile 7 bis 92 uebertragen
  Sheets(Format(Cells(1, 1).Value, "MMMM")).Range(Cells(7, icol), Cells(92, icol + 5)).Copy
  Cells(7, 3).PasteSpecial Paste:=xlFormats
End If

Eine Prüfung, ob denn das Blatt existiert, wäre vielleicht noch von Vorteil. Falls die Formate aus dem kompletten Bereich zu viel sind, könnte man auch die Übernahme auf die betreffenden Zeilen vereinzeln.

[Fennek]

Hallo,

die Zuweisung der Farben kann vereinfacht werden:

Code:

Dim Tx As String, iCol As Integer

Tx = "PKG20"

Select Case Tx
    Case "PKG20", "PKG40", "PVM20", "PVM40", "PM20", "PM40", "CMDP20", "CMDP40": iCol = 26
        
End Select

Cells(1, 1).Interior.ColorIndex = iCol

mfg

[snb]

Code:

Tx = "PKG20"

Select Case right(Tx,2)
  Case "20", "40"
    iCol = 26
  --- -- - -
End Select

Cells(1, 1).Interior.ColorIndex = iCol

[Arni49]

Hallo,

ich habe die Code von "SNB" und Fennek ausprobiert, das einfärben auf der Monats Tabelle funktioniert nicht nachdem eine Behandlungsart eingetragen wird??? Liegt sicherlich an mir :) könntet ihr mir das in die PraxisForum.xlsm einarbeiten und hochladen?

Schauan:
Kannst Du mir aufzeigen wie der gesamte Code einer Monatstabelle bzw. der Tabelle TermineTagesaktuell aussehen muss?


Bin zu lange raus aus dem Thema und deshalb liegt es sicherlich an mir das ich es nicht zum funktionieren bringe :(

Danke
Grüße

---

Code:

Dim Tx As String, iCol As Integer

Tx = "PKG20"

Select Case Tx
    Case "PKG20", "PKG40", "PVM20", "PVM40", "PM20", "PM40", "CMDP20", "CMDP40": iCol = 26
       
End Select

Cells(1, 1).Interior.ColorIndex = iCol

Sorry habe nochmal genauer hingesehen, der Code funktioniert natürlich bzw. auf die angegebene Cells (1,1) also A1 oder was auch immer da eingegeben wird.
Ziel ist es das egal in welche Behandlungszelle (Grau gekennzeichnet) auf dem gesamten Blatt dies geändert wird, es entsprechend eingefärbt wird. 

Gruß

[schauan]

Hallöchen,

also, im Code von TermineTagesaktuell sollte es doch nicht so schwer sein.
Die erste Prüfung endet in der 4. Codezeile vor dem End Sub mit End If. Eingefügt würde es so aussehen:

Code:

...
    End If

If Target.Address = "$A$1" Then
  Dim icol As Integer
  'Startspalte berechnen
  icol = 6 * Format(Cells(1, 1).Value, "D") - 3
  Sheets(Format(Cells(1, 1).Value, "MMMM")).Range(Cells(7, icol), Cells(92, icol + 5)).Copy
  Cells(7, 3).PasteSpecial Paste:=xlFormats
End If
    
    Application.EnableEvents = True
    Set RaBereich = Nothing

End Sub

Der Code im Blatt Dezember wäre Fleißarbeit.
Hier gerne auch noch mit dem zweiten Case, aber das Prinzip sollte auch einfach umzusetzen sein.
Du fügst immer
With Sheets("TermineTagesaktuell").Cells(RaZelle.Row, icol)
und
End With
ein und dazwischen übernimmst Du nochmal das zum Case zugehörige Einfärben. Vergleiche einfach mal die Zeilen zwischen With... und End With mit den Zeilen unmittelbar darüber.

Code:

With RaZelle
            icol = 2 + (RaZelle.Column - 2) Mod 6 - (6 * (((RaZelle.Column - 2) Mod 6) = 0))
                Select Case UCase(.Value)           ' Umwandlung der Eingabe in Großbuchstaben
                    Case Sheets("Parameter").Range("E1").Value  'Für Leer Zellen
                        .Interior.ColorIndex = Sheets("Parameter").Range("f1")          ' Füllfarbe
                        .Font.ColorIndex = Sheets("Parameter").Range("g1")
                        With Sheets("TermineTagesaktuell").Cells(RaZelle.Row, icol)
                            .Interior.ColorIndex = Sheets("Parameter").Range("f1")          ' Füllfarbe
                            .Font.ColorIndex = Sheets("Parameter").Range("g1")
                        End With
                    Case Sheets("Parameter").Range("E3").Value  'PKG20
                        .Interior.ColorIndex = Sheets("Parameter").Range("F3")        ' Füllfarbe Pink
                        .Font.ColorIndex = Sheets("Parameter").Range("G3")              ' Schriffarbbe schwarz
                        .NumberFormat = "General"   ' Zellenformat Standard
                        icol = 2 + (RaZelle.Column - 2) Mod 6 - (6 * (((RaZelle.Column - 2) Mod 6) = 0))
                        With Sheets("TermineTagesaktuell").Cells(RaZelle.Row, icol)
                            .Interior.ColorIndex = Sheets("Parameter").Range("F3")        ' Füllfarbe Pink
                            .Font.ColorIndex = Sheets("Parameter").Range("G3")              ' Schriffarbbe schwarz
                            .NumberFormat = "General"   ' Zellenformat Standard
                        End With
                    Case Sheets("Parameter").Range("e4").Value 'PKG40

[Arni49]

Hallo,

Die Behandlungsfelder im Dezember werden entsprechend der Eingabe eingefärbt.
In TermineTagesaktuell werden auch die entsprechenden Felder gleich farblich eingefärbt, gibt es jetzt noch die Möglichkeit den Inhalt der geänderten Behandlungszelle mit zu übertragen? Dann benötige ich die Formeln in den Zellen der Tabelle TermineTagesaktuell im Bereich C7:H92 und Q7:CP92 für alle Monate, aktuell in der Forum Version nur Dez P7:U92 nicht mehr.

und kannst Du mir dies Anweisung erläutern?

Code:

icol = 2 + (RaZelle.Column - 2) Mod 6 - (6 * (((RaZelle.Column - 2) Mod 6) = 0))

Grüße

[schauan]

Hallöchen,

gibt es jetzt noch die Möglichkeit den Inhalt der geänderten Behandlungszelle mit zu übertragen?

Dann würde man zusätzlich zu den Formaten (Pastespecial paste:=xlFormats) in einem 2. Anlauf die Werte holen (... Paste:=xlValues)

icol = 2 + (RaZelle.Column - 2) Mod 6 - (6 * (((RaZelle.Column - 2) Mod 6) = 0))

Mit der Formel ermittle ich zu färbende Spalte eines Tages auf dem Blatt TermineTagesaktuell anhand der Eingabespalte

Deine Tagesbereiche sind immer 6 Spalten breit - dafür die 6en und beginnen in Spalte C - also 2 weiter als die Spalte 1 - dafür die 2en.
Du kannst Dir mal verschiedene Ausdrücke der Codezeile in die Überwachung nehmen, z.B.

RaZelle.Column --> ist die Spalte wo Du was auswählst
(RaZelle.Column - 2) Mod 6 - -> ergibt die nte Spalte vom Tag des Monats (ganzzahliger Rest vom Divisionsergebnis, z.B. 13 mod 6 = 1)
6 * (((RaZelle.Column - 2) Mod 6) = 0) --> ergibt 6 oder 0, wegen dem Rest 0 in der letzten Spalte eines Tages, z.B. bei 6 mod 6, 12 mod 6 usw.

Füge noch einen Stop eine codezeile danach ein und schaue Dir die Werte an. Teste das mit verschiedenen Spalten.