Wie Zeile in bestehendes Makro einfügen?

[schauan]

Hallöchen,

kannst Du die Aufgabenstellung hinsichtlich der Markierung noch präzisieren? Es gäbe zwei Varianten. Zum einen immer die Woche mit dem ersten des Jahres die Farben setzen - da kann aber auch mal zum Jahresende die 52 und die 52 des Vorjahres und anschließen die 1 des Folgejahres farbig sein oder die markierten Wochen rollieren über die Jahre, dann kann auch mal die KW51 des Vorjahres die letzte und die KW03 die erste Farbige sein.

[ossi]

Hallo Andre,
schön, dass du dich an der Lösungsfindung beteiligst.
Ich will mal versuchen, die Problematik genauer zu beschreiben.
Begonnen wird im Jahr 2019. Am 1.01.2019 (A5) wird richtigerweise die Woche 1 in Klammer hervorgehoben. Weiter geht es richtig bei den Monaten Februar bis November.
Im Dezember wird dann richtig die Woche 49 und die Woche 1 (am 30.12.) hervorgehoben.
Wähle ich nun das Jahr 2020, klappt alles wie in 2019.
Im Dezember 2020 wird richtig am 01. die Woche 49 in Klammer hervorgehoben und auch richtig die Woche 53 am 28.12.2020
Wähle ich nun das Jahr 2021 wird am 01.01. auch richtig die Woche 53 in Klammer hervorgehoben.
Fälschlicherweise wird jetzt am 04.01.2021 die Woche 1 hervorgehoben. Richtig wäre - wegen dem 4 Wochen-Rhythmus - die Woche 4, dann die Woche 8 usw. hervorzuheben.
Der Wochenrhythmus sollte also über die Jahre hinweg immer beibehalten werden und die jeweilige Wochenzahl - mit und ohne Klammer - hervorgehoben werden.
Das Funktionierende Makro von Uwe sieht so aus:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
 Application.ScreenUpdating = False 'Bildschirmaktualisierung abschalten.
   Dim obj_cell As Object
   Dim obj_wks As Object
   If Target.Column = 3 And Target.Row = 7 Then
     For Each obj_wks In ThisWorkbook.Worksheets
       Select Case obj_wks.Name
         Case "Jahr Eingabe", "Feiertage", "!"
         Case Else
           obj_wks.Unprotect
           With obj_wks.Range("A5:A35")
             .Font.ColorIndex = xlAutomatic
             .Font.Bold = False
             For Each obj_cell In .Cells
               If (0 & Replace(Replace(obj_cell.Value, "(", ""), ")", "")) Mod 4 = 1 Then
                 obj_cell.Font.ColorIndex = 50
                 obj_cell.Font.Bold = True
               End If
             Next
           End With
           obj_wks.Protect
       End Select
     Next
   End If
 Application.ScreenUpdating = True 'Bildschirmaktualisierung wieder einschalten.
End Sub

Ich würde mich freuen, wenn es hierfür eine Lösung gibt.

Gruß
ossi

[schauan]

Hallöchen,

ich hab hier mal in Tabellenform zwei Ansätze. Der Punkt hier ist, dass ich nicht über die KW gehe sondern auf Basis des Datums rechne, und das passt dann solange es Excel gibt
Bei der einen Variante dividiere ich die "Datums-Zahl" durch 28 - (/*4 für 4 Wochen) und schaue nur, ob sich die Ganzzahl ändert - was sie alle 4 Wochen tut. Bei der anderen Variante würde ich von einem Startdatum eine entsprechende Anzahl Tage abziehen um irgendwo bei 0 rauszukommen und schaue, ob bei der Division durch 28 der Rest 0 ist. Wenn das passt, könnte man es im VBA umsetzen. Kannst ja zum Test die Formeln und Daten weiter runter ziehen und auch ein anders  Startdatum nehmen . dann auch den Subtrahend anpassen - … Für die Formatierung kannst Du in einem Fall die 1 und in dem anderen Fall die 0 verwenden.  

Arbeitsblatt mit dem Namen 'Tabelle1'
	A	B	C	D	E	F
1	31.12.2018	43465	1552,32143		0	0
2	07.01.2019	43472	1552,57143	0	7	1
3	14.01.2019	43479	1552,82143	0	14	1
4	21.01.2019	43486	1553,07143	1	21	1
5	28.01.2019	43493	1553,32143	0	28	0
6	04.02.2019	43500	1553,57143	0	35	1
7	11.02.2019	43507	1553,82143	0	42	1
8	18.02.2019	43514	1554,07143	1	49	1
9	25.02.2019	43521	1554,32143	0	56	0
10	04.03.2019	43528	1554,57143	0	63	1
11	11.03.2019	43535	1554,82143	0	70	1
12	18.03.2019	43542	1555,07143	1	77	1
13	25.03.2019	43549	1555,32143	0	84	0
14	01.04.2019	43556	1555,57143	0	91	1
15	08.04.2019	43563	1555,82143	0	98	1

Zelle	Formel
B1	=A1
C1	=B1/(4*7)
E1	=B1-43465
F1	=WENN(REST(E1;28);1;0)
B2	=A2
C2	=B2/(4*7)
D2	=WENN(GANZZAHL(B1/(4*7))<>(GANZZAHL(B2/(4*7)));1;0)
E2	=B2-43465
F2	=WENN(REST(E2;28);1;0)

Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016

Diese Tabelle wurde mit Tab2Html (v2.6.2) erstellt. ©Gerd alias Bamberg

[Kuwer]

Hallo ossi,

so sollte es klappen:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim i As Long

    Dim obj_cell As Object

    Dim obj_wks As Object

    If Target.Column = 3 And Target.Row = 7 Then

      If Weekday(DateSerial(Worksheets("Jahr Eingabe").Range("C7").Value, 1, 1), 2) > 4 Then i = 1

      For Each obj_wks In ThisWorkbook.Worksheets

        Select Case obj_wks.Name

          Case "Jahr Eingabe", "Feiertage", "!"

          Case Else

            obj_wks.Unprotect

            With obj_wks.Range("A5:A35")

              .Font.ColorIndex = xlAutomatic

              .Font.Bold = False

              For Each obj_cell In .Cells

                If (--(0 & Replace(Replace(obj_cell.Value, "(", ""), ")", "")) + i) Mod 4 = 1 _

                                        Or obj_cell.Value = "(1)" Or obj_cell.Value = "(53)" Then

                  obj_cell.Font.ColorIndex = 50

                  obj_cell.Font.Bold = True

                End If

              Next

            End With

            'obj_wks.Protect

        End Select

      Next

    End If

End Sub

Gruß Uwe

[ossi]

Hallo Uwe,
ja, so klappt's. Aber es gibt noch ein Problem:
Im Jahr 2023 ist der 25.12. ein Montag und die Woche 52. Sie sollte eigentlich hervorgehoben sein. Stattdessen wird ## angezeigt. Ich kann mir nicht erklären, warum das so ist.

Dez

A

B

C

D

E

F

G

H

I

J

K

L

M

29

##

Mo    25

1. Weihnachtstag

30

Di    26

2. Weihnachtstag

Formeln der Tabelle

Zelle Formel A29 =WENN(WOCHENTAG(B29)=2;dKW(B29);"") B29 =WENN(B28="";"";WENN(MONAT(B28+1)=MONAT($A$4);DATUM(gewJahr;MONAT($A$4);TAG(B28+1));"")) I29 =WENN(ANZAHL(C29:D29)=2;(REST(D29-C29;1)>1/4)/48;0)+WENN(ANZAHL(G29:H29)=2;(REST(H29-G29;1)>1/4)/48; 0) J29 =WENN(ISTNV(INDEX($S$9:$T$37;VERGLEICH($B29;$S$9:$S$37;0);2));"";INDEX($S$9:$T$37;VERGLEICH($B29;$S$9:$S$37;0);2)) K29 =WENN(ODER(C29="Krank";C29="Urlaub");1/3;WENN(UND(C29<>"";D29<>"";C29<=D29);D29-C29;0)+WENN(UND(E29<>"";F29<>"";E29<=F29);F29-E29;0)+WENN(UND(G29<>"";H29<>"";G29<=H29);H29-G29;0)-I29) L29 =K29*24 M29 =K29*$P$7*24 A30 =WENN(WOCHENTAG(B30)=2;dKW(B30);"") B30 =WENN(B29="";"";WENN(MONAT(B29+1)=MONAT($A$4);DATUM(gewJahr;MONAT($A$4);TAG(B29+1));"")) I30 =WENN(ANZAHL(C30:D30)=2;(REST(D30-C30;1)>1/4)/48;0)+WENN(ANZAHL(G30:H30)=2;(REST(H30-G30;1)>1/4)/48; 0) J30 =WENN(ISTNV(INDEX($S$9:$T$37;VERGLEICH($B30;$S$9:$S$37;0);2));"";INDEX($S$9:$T$37;VERGLEICH($B30;$S$9:$S$37;0);2)) K30 =WENN(ODER(C30="Krank";C30="Urlaub");1/3;WENN(UND(C30<>"";D30<>"";C30<=D30);D30-C30;0)+WENN(UND(E30<>"";F30<>"";E30<=F30);F30-E30;0)+WENN(UND(G30<>"";H30<>"";G30<=H30);H30-G30;0)-I30) L30 =K30*24 M30 =K30*$P$7*24

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
Gruß
ossi

---

Hallo Andre,

danke für deinen Lösungsvorschlag. Der ist mir aber zu kompliziert und ich weiß nicht, wie man das umsetzt. Du kannst dir ja mal die Muster.xls im Thread anschauen.

Gruß
ossi

[Kuwer]

Ich kann mir nicht erklären, warum das so ist.

Ich auch nicht. Aber das hat mit dem Makro nichts zu tun!
Aber dafür wird die erste Woche 2024 auch grün markiert
Ich glaube, das wird so nichts. Bei solcher fortlaufender Zählung muss doch irgendwie hinterlegt werden, wann die letzte 4. Woche war.

Gruß Uwe

[ossi]

Hallo Uwe,
es passiert ja nur am 1. Weihnachtsfeiertag (25.12.) wenn dieser ein Montag ist und gleichzeitig die 4. Woche wie in 2023.
Vielleicht könnte man im Dezemberblatt mit der bedingten Formatierung arbeiten (A5:A35). Hast du eine Idee?

Gruß
ossi

[schauan]

Moin Uwe,
Schau Dir mal meinen Ansatz an. Bin jetzt nur am Smartphone und kann erst heute Abend. Ich nehme so ein Prinzip mit einem Startdatum z. B. auch für einen Schichtkalender... Mein Startdatum ist schon seit Jahren das Gleiche :17:

[Kuwer]

Hallo ossi,

Hallo Uwe,
es passiert ja nur am 1. Weihnachtsfeiertag (25.12.) wenn dieser ein Montag ist und gleichzeitig die 4. Woche wie in 2023.
Vielleicht könnte man im Dezemberblatt mit der bedingten Formatierung arbeiten (A5:A35). Hast du eine Idee?

Gruß
ossi

bei mir bzw. in Deiner "Beispieldatei" funktioniert es (die Bedingten Formatierungen habe ich entfernt): Die 52 beim 25.12. wird grün und es gibt auch keine ##.

Gruß Uwe

[ossi]

Hallo Uwe,


könntest du mal diese funktionierende Mappe hochladen?

Gruß
ossi