Wie Zeile in bestehendes Makro einfügen?

[ossi]

Hallo Leute,

ich habe folgendes Makro, das mir jede 4. Wochenzahl farblich hervorhebt.
Ich soll ein Zeile einfügen, damit die in Klammern ausgegebene 4. Wochenzahl ebenfalls berücksichtigt wird.
Ich weiß nicht wie das Makro danach aussehen soll.
Das Makro:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
   Dim obj_cell As Object
   Dim obj_wks As Object
   Dim lng_zaehler As Long
   If Target.Column = 3 And Target.Row = 7 Then
       For Each obj_wks In ThisWorkbook.Worksheets
           If obj_wks.Name <> "Jahr Eingabe" And obj_wks.Name <> "Feiertage" Then
               obj_wks.Unprotect
               For Each obj_cell In obj_wks.Range("A5:A35 ").Cells
                   For lng_zaehler = 1 To 53 Step 4
                       If obj_cell.Value = lng_zaehler Then
                           obj_cell.Font.ColorIndex = 50
                           obj_cell.Font.Bold = True
                       If Left(Cells(5, 1), 1) = "(" Then
                       Cells(5, 1).Font.ColorIndex = 50
                       Cells(5, 1).Font.Bold = True
                       End If
                       End If
                   Next
               Next
               obj_wks.Protect
           End If
       Next
   End If

Die einzufügende Zeile:
If --replace(replace(obj_cell.Value,"(",""),")","") = lng_zaehler Then

Gruß
ossi

[Kuwer]

Hallo ossi,

ersetze die Zeile

If obj_cell.Value = lng_zaehler Then

durch

If 0 & Replace(Replace(obj_cell.Value, "(", ""), ")", "") = lng_zaehler Then

Gruß Uwe

[ossi]

Hallo Uwe,

danke für die Hilfe. Habe das so gemacht und es sieht jetzt so aus:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
    Dim obj_cell As Object
    Dim obj_wks As Object
    Dim lng_zaehler As Long
    If Target.Column = 3 And Target.Row = 7 Then
        For Each obj_wks In ThisWorkbook.Worksheets
            If obj_wks.Name <> "Jahr Eingabe" And obj_wks.Name <> "Feiertage" Then
                obj_wks.Unprotect
                For Each obj_cell In obj_wks.Range("A5:A35 ").Cells
                    For lng_zaehler = 1 To 53 Step 4
                        'If obj_cell.Value = lng_zaehler Then
                         If 0 & Replace(Replace(obj_cell.Value, "(", ""), ")", "") = lng_zaehler Then
                            obj_cell.Font.ColorIndex = 50
                            obj_cell.Font.Bold = True
                        If Left(Cells(5, 1), 1) = "(" Then
                        Cells(5, 1).Font.ColorIndex = 50
                        Cells(5, 1).Font.Bold = True
                        End If
                        End If
                    Next
                Next
                obj_wks.Protect
            End If
        Next
    End If
    Application.ScreenUpdating = True
    End Sub
Beim Ausführen bleibt das Makro vor dieser Zeile stehen und ist gelb unterlegt. Die Meldund:
Laufzeitfehler '13.
Typen unverträglich.

Gruß
ossi

[Kuwer]

Hallo ossi,

dann bleibt nach dem Ersetzen in der entsprechenden Zelle keine Zahl übrig.

Gruß Uwe

[ossi]

Hallo Uwe,

ohne diese eingefügte Zeile wird in den Monatsblättern jede 4. Wochenzahl farblich hervorgehoben. In der 1. Zelle A5 wird bei jedem Monat die Wochenzahl in Klammern zusätzlich angezeigt, wenn es kein Wochenbeginn - sprich Montag - ist. Wenn Montag dann natürlich normal ohne Klammer.
Handelt es sich um eine 4. Wochenzahl, die ja in der letzen Woche des Vormonats beginnt, soll diese in Klammern dargestellte Wochenzahl im Folgemonat am 01. auch farblich in Klammern hervorgehoben werden.
Beispiel für 2019:
Die Woche 1 beginnt am 31.12.2018 und wird richtig farblich hervorgehoben. Jetzt sollte auch am 01. Januar 2019 die 1 in Klammer farblich hervorgehoben werden.
Die Woche 5 beginnt am 28.01.2019 und wird richtig farblich hervorgehoben. Jetzt sollte auch am 01. Februar die 5 in Klammer farblich hervorgehoben werden. Das gleiche für Februar:
Die Woche 9 beginnt am 25.02.2019 und wird auch hier richtig farblich hervorgehoben. Jetzt sollte auch am 01. März die 9 in klammer farblich hervorgehoben werden.

Gruß
ossi

[Kuwer]

Hallo ossi,

leider verstehe ich Dein Makro ohne zugehörige Datei nicht wirklich, so dass ich Dir da nicht weiterhelfen kann.
Günter hat Dir ja den Link geschrieben, wie man eine Datei hochlädt, falls Du das möchtest.

Gruß Uwe

[ossi]

  Muster.xls (Größe: 205,5 KB / Downloads: 6)
Hallo Uwe,

ich lade mal die Musterdatei hoch.
Ich habe in A4 den Monat März gewählt.
Wie siehst, wird die Woche 13 farblich richtig hervorgehoben.
Die Woche  9 in Klammern in A5 sollte aber auch farblich hervorgehoben sollte aber auch farblich hervorgehoben , da sie die Vorgabe jede 4. Woche farblich hervorzuheben.
Ebenso sollte die Woche 1 in Klammern im Januarblatt in A5 farblich herborgehoben sein.

Gruß
ossi

[Kuwer]

Hallo ossi,

dass das Makro in Fehler lief, lag daran, dass Du das ausgeblendete Blatt "!" nicht im Code berücksichtigt hast. Ich habe das ergänzt und gleichzeitig diese entsprechende If-Abfrage umgestellt auf Select Case, da das (für mich) übersichtlicher ist.

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim obj_cell As Object
   Dim obj_wks As Object
   Dim lng_zaehler As Long
   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
           For Each obj_cell In obj_wks.Range("A5:A35").Cells
             For lng_zaehler = 1 To 53 Step 4
               If 0 & Replace(Replace(obj_cell.Value, "(", ""), ")", "") = lng_zaehler Then
                 obj_cell.Font.ColorIndex = 50
                 obj_cell.Font.Bold = True
               End If
             Next
           Next
           'obj_wks.Protect
       End Select
     Next
   End If
End Sub

Ich würde jedoch die Zählschleife weg lassen und auch vorher die Formatierung des Bereiches erst einmal zurück setzen.

Private Sub Worksheet_Change(ByVal Target As Range)
   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
End Sub

Jetzt kommt das Aber:
Du hast für den Bereich A5:A35 schon Bedingte Formatierungen hinterlegt, die eh Vorrang vor manuellen Formatierungen haben.
Du musst nur die Formel der ersten Regel
=REST(A5-1;4)=0
in
=REST(WECHSELN(WECHSELN(A5;"(";"");")";"");4)=1
ändern. Das Makro ist somit überflüssig.

Gruß Uwe

[ossi]

Super! Das funktioniert prima.


Ich habe gerade bemerkt, dass ich dir ein früheres Muster geschickt habe, bei der noch diese bedingte Formatierung dabei war.
Bei meiner aktuellen Datei, in die ich dein korrigiertes Makro eingefügt habe ist diese bedingte Formatierung nicht mehr vorhanden.
Jetzt gibt es noch ein Problem, da das Jahr 2020 53 Wochen hat. Die Woche 53 wird auch richtig farblich hervorgehoben.
Wenn ich jetzt das Jahr 2021 wähle, wird zwar am 01.01.2021 die Wochenzahl 53 richtig in Klammern farblich hervorgehoben, aber zusätzlich auch die Woche 1 am 04.01.2021 wird farblich hervorgehoben. Wegen der 4-Wochen-Regelung dürfte diese aber nicht hervorgehoben sein, sondern die Woche 4 am 25.01.2021, dann wieder die Woche 8 usw.
Im Prinzip müsste zuvor eine Prüfung erfolgen, wieviele Wochen das Jahr hat.

Gruß
ossi

[ossi]

Hallo Uwe,
gibt es überhaupt eine Lösung für dieses Problem?
Kann ich noch mit einer Antwort rechnen?

Gruß
ossi