Registriert seit: 31.08.2019
Version(en): 2019
31.08.2019, 13:00
(Dieser Beitrag wurde zuletzt bearbeitet: 31.08.2019, 13:05 von WillWissen.
Bearbeitungsgrund: Codetags
)
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
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
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
Registriert seit: 31.08.2019
Version(en): 2019
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
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
31.08.2019, 16:32
(Dieser Beitrag wurde zuletzt bearbeitet: 31.08.2019, 16:32 von Kuwer.)
Hallo ossi,
dann bleibt nach dem Ersetzen in der entsprechenden Zelle keine Zahl übrig.
Gruß Uwe
Registriert seit: 31.08.2019
Version(en): 2019
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
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
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
Registriert seit: 31.08.2019
Version(en): 2019
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
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
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
Registriert seit: 31.08.2019
Version(en): 2019
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
Registriert seit: 31.08.2019
Version(en): 2019
Hallo Uwe,
gibt es überhaupt eine Lösung für dieses Problem?
Kann ich noch mit einer Antwort rechnen?
Gruß
ossi
|