Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.09.2025 18:34:36
Welches Datum gibt mein M-Code aus?
26.09.2025 10:29:46
Wert aus einer Zelle bei jeder Eingabe in neue Zelle
26.09.2025 08:51:00
Teilinhalt einer Zelle vergleichen
25.09.2025 23:04:12
Einen von drei möglichen Einträgen in einer Zeile suchen
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1708to1712
1708to1712
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

bestimmte Kalenderwoche hervorheben (Makro)

Forumthread: bestimmte Kalenderwoche hervorheben (Makro)

bestimmte Kalenderwoche hervorheben (Makro)
27.08.2019 19:58:34
mike49
Hallo,
in meinen Kalendermonaten wird die jeweilige Kalenderwoche mit diesem Makro:
Option Explicit
Rem UDF zur Ermittlung jeweiliger Kalenderwoche nach DIN 1355 
Function dKW(dat As Date)
Dim a As Long
On Error GoTo fx
a = Int((dat - DateSerial(Year(dat), 1, 1) + _
((Weekday(DateSerial(Year(dat), 1, 1)) + 1) Mod 7) - 3) / 7) + 1
If a = 0 Then
a = dKW(DateSerial(Year(dat) - 1, 12, 31))
ElseIf a = 53 And (Weekday(DateSerial(Year(dat), 12, 31)) - 1) Mod 7

über die Formel =WENN(WOCHENTAG(B5)=2;dKW(B5);"") im Bereich A5:A35 eingetragen.
Wie kann ich mittels Makro erreichen, dass jede 4 Wochenzahl (1,5,9,13 usw.)farblich hervorgehoben wird?
Ich bräuchte eine Makrolösung, da die Bedingte Formatierung ausscheidet.
Gruß
mike49
Anzeige

26
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: bestimmte Kalenderwoche hervorheben (Makro)
27.08.2019 20:12:28
Regina
Hi,
müsste so passen: 
Public Sub vier_wochen()
Dim obj_cell As Object
Dim lng_zaehler As Long
For Each obj_cell In Range("A5:A35").Cells
For lng_zaehler = 1 To 53 Step 4
If obj_cell.Value = lng_zaehler Then
obj_cell.Interior.Color = vbRed
End If
Next
Next
End Sub
Gruß
Regina
Anzeige
AW: bestimmte Kalenderwoche hervorheben (Makro)
27.08.2019 20:17:01
mike49
Hallo Regina,
danke für deine Hilfe.
Wohin muss das Makro? Ins jeweilige Arbeitsblatt oder in die Arbeitsmappe?
Gruß
mike49
AW: bestimmte Kalenderwoche hervorheben (Makro)
27.08.2019 20:20:04
Regina
na ja, wann soll es den starten?
Bei Klick auf ein Button
oder
Bei veränderungn im Arbeitsblatt? Wenn ja, in welchen Zellen finden die Veränderungen statt?
Gruß
Regina
Anzeige
AW: bestimmte Kalenderwoche hervorheben (Makro)
27.08.2019 20:24:52
mike49
Bei Veränderungen im Arbeitsblatt im Bereich A5:A35.
AW: bestimmte Kalenderwoche hervorheben (Makro)
27.08.2019 20:40:39
Regina
Hi, da finden keine echten Veränderungen statt. Formelergebnisse lösen kein Worksheet_Change-Ereignis aus. Wo findet die manuelle Verändserung statt, die die Ausgabe in Spalte A beeinflusst?
Gruß
Regina
Anzeige
AW: bestimmte Kalenderwoche hervorheben (Makro)
27.08.2019 21:14:23
mike49
Hast du dir die Mustermappe mal angeschaut?
Die Eintragung der Wochenzahl hängt vom Jahr und Monat ab. Die wird ja auch richtig eingetragen.
Ich möchte aber, dass bei dieser Erst-Eintragung jede 4. Wochenzahl farblich hervorgehoben wird.
Wie du in der Mustermappe erkennen kannst, wird durch Einfügen einer weiteren Regel über die Bedingte Formatierung die Feiertagseinfärbung aufgehoben. Deshalb eine Makrolösung.
Mir geht es im Prinzip nur die einmalige farbliche Hervorhebung jeder 4. Wochenzahl.
Gruß
mike49
Anzeige
AW: bestimmte Kalenderwoche hervorheben (Makro)
27.08.2019 21:28:55
Regina
Hi,
dann gehört dieser Code in das Code-Modul vim Tabellenblatt "Jahr Eingabe"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim obj_cell As Object
Dim lng_zaehler As Long
If Target.Column = 3 And Target.Row = 7 Then
For Each obj_cell In Worksheets("Apr").Range("A5:A35").Cells
For lng_zaehler = 1 To 53 Step 4
If obj_cell.Value = lng_zaehler Then
obj_cell.Interior.Color = vbRed
End If
Next
Next
End If
End Sub
Gruß
Regina
Anzeige
AW: bestimmte Kalenderwoche hervorheben (Makro)
27.08.2019 22:17:49
mike49
Hallo Regina,
so klappt's.
Allerdings möchte ich nicht Interior.Color=vbRed, sondern es soll nur die Schriftfarbe rot sein.
Außerdem müssten alle Monate berücksichtigt werden. Also die Zeile in etwa so erwitert werden
For Each obj_cell In Worksheets("Jan,Feb,Mrz,Apr,Mai,Jun,Jul,Aug,Sep,Okt,Nov,Dez").Range("A5:A35").Cells
Allerdings funktioniert's so nicht.
Gruß
mike49
Anzeige
AW: bestimmte Kalenderwoche hervorheben (Makro)
27.08.2019 22:43:37
mike49
Ich hab jetzt folgendes eingetragen: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim obj_cell As Object
Dim lng_zaehler As Long
If Target.Column = 3 And Target.Row = 7 Then
For Each obj_cell In Worksheets("Jan,Feb,Mrz,Apr,Mai,Jun,Jul,Aug,Sep,Okt,Nov,Dez").Range(" _
A5:A35").Cells
For lng_zaehler = 1 To 53 Step 4
If obj_cell.Value = lng_zaehler Then
obj_cell.Font.ColorIndex = 50
End If
Next
Next
End If
End Sub
Das mit den Worksheets funktioniert nicht. Wie muss geändert werden?
Anzeige
AW: bestimmte Kalenderwoche hervorheben (Makro)
28.08.2019 08:20:19
Regina
Hi,
Du musst mit einer Schleife durch die Tabellenblätter laufen und die, die nicht beachtet werden sollen ausschließen. So sollte es gehen:
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
If obj_wks.Name  "Jahr Eingabe" And obj_wks.Name  "Feiertage" Then
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
End If
Next
Next
End If
Next
End If
End Sub
Gruß Regina
Anzeige
AW: bestimmte Kalenderwoche hervorheben (Makro)
28.08.2019 08:47:29
mike49
Guten Morgen Regina,
ja, so funktioniert es. Allerdings nur, wenn ich zuvor den Blattschutz der Arbeitsblätter aufgehoben habe.
Kann man das ändern, dass das Makro bei eingeschaltetem Blattschutz läuft?
LG
mike49
AW: bestimmte Kalenderwoche hervorheben (Makro)
28.08.2019 08:57:18
Pierre
Hallo Mike,
2. Zeile im Code: 
ActiveWorkbook.Unprotect Password:="DEINPASSWORT"
und dann vor "End Sub" folgende: 

ActiveWorkbook.Protect Password:="DEINPASSWORT"
Gruß Pierre
Anzeige
AW: bestimmte Kalenderwoche hervorheben (Makro)
28.08.2019 09:59:51
Regina
Nein, aber du kannst denn Blattschutz aufheben und neu setzen:
Vor der zweiten for-schleife:
obj_wks.unprotect
und nach der Schleife
obj_wks.protect
Gruß
Regina
AW: bestimmte Kalenderwoche hervorheben (Makro)
28.08.2019 10:53:41
mike49
Hallo Regina,
ich hab's jetzt so gemacht: 
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
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
obj_wks.Protect
If obj_cell.Value = lng_zaehler Then
obj_cell.Font.ColorIndex = 50
End If
Next
Next
End If
Next
End If
End Sub

Aber nach Eingabe der Jahreszahl bleibt das Makro stehen. Die Zeile obj_cell.Font.ColorIndex = 50 ist gelb unterlegt. Übrigens: Wie könnte man die Schriftfarbe fett darstellen?
Gruß
mike49
Anzeige
AW: bestimmte Kalenderwoche hervorheben (Makro)
28.08.2019 14:04:00
mike49
Hallo Regina,
ich habe schon mehrmals probiert, aber irgendwie krieg ich's nicht hin.
Wie würde denn dass komplette Makro richtig lauten?
Gruß
mike49
AW: bestimmte Kalenderwoche hervorheben (Makro)
28.08.2019 14:21:32
Regina
so: 
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
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
End If
Next
Next
obj_wks.Protect
End If
Next
End If
End Sub
Gruß Regina
Anzeige
AW: bestimmte Kalenderwoche hervorheben (Makro)
28.08.2019 07:02:40
Pierre
Hallo Mike,
warum scheidet bed. Formatierung aus?
Die dir bekannte Formel konntest du drin lassen. (Wäre in der Rangfolge Nr. 2 geworden).
Auf Nr. 1 nur folgende Formel: 

=WENN(UND(REST(A5-1;4)=0);ISTZAHL(SVERWEIS($B5;Feiertage;1;0)))

Hier dann sowohl gewünschte Schriftfarbe als auch Füllfarbe auswählen, fertig.
Wie du siehst, habe ich deine bestehende Formel zur Feiertagsfindung bzw. -einfärbung mit der von UweD im anderen Thread genannten Rest-Formel verbunden.
S. auch die geänderte Mappe (ich habe extra eine dunklere Farbe zur Veranschaulichung gewählt
und in Zelle A33 ebenfalls zur Veranschaulichung händisch die nächste zutreffende KW eingetragen.)
https://www.herber.de/bbs/user/131666.xls
Oder habe ich das völlig falsch verstanden und das ist gar nicht das, was du wolltest?
Anzeige
AW: bestimmte Kalenderwoche hervorheben (Makro)
28.08.2019 10:17:30
mike49
Hallo Pierre,
ich habe mal getestet. Aber irgendwie passt's noch nicht.
Ändere mal in deiner Mustermappe den Monat in A6 auf 6.
Beim Pfingstmonat wird die Wochenzahl 24 nicht farbig dargestellt.
Gruß
mike49
AW: bestimmte Kalenderwoche hervorheben (Makro)
28.08.2019 11:28:49
mike49
Upps,
da bin ich im Irrtum! Die Wochenzahl beim Pfingstmontag ist ja nicht die 4. Woche und wird deshalb ja auch nicht hervorgehoben. Sorry.
Anzeige
Hallo Pierre
28.08.2019 12:36:30
mike49
mit der Makrolösung klappt's am Besten.
Ich habe das Makro mit dem Blattschutz erweitert, allerdings bleibt es immer bei der Zeile
obj_cell.Font.ColorIndex = 50
stehen. Diese ist dann gelb unterlegt.
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveWorkbook.Unprotect
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
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
End If
Next
Next
End If
Next
End If
ActiveWorkbook.Protect
End Sub
Habe ich was falsch gemacht?
Gruß
mike49
Anzeige
sorry, keine Ahnung ...
28.08.2019 13:53:52
Pierre
... was da falsch ist.
Gruß Pierre
AW: sorry, keine Ahnung ...
28.08.2019 14:00:38
mike49
Ist das Einfügen der Zeilen
ActiveWorkbook.Unprotect und ActiveWorkbook.Protect
richtig?
AW: Hallo Pierre
28.08.2019 14:18:50
Regina
Hi,
ActiveWorkbook.Unprotect
hebt den Blattschutz nicht auf
Nimm die Variante, die ich Dir zum Aufheben des Blattschutzes beschrieben habe.
Gruß
Regin
Anzeige
AW: Hallo Pierre
28.08.2019 15:24:41
mike49
Hallo Regina,
danke, dass du dich nochmals gemeldet hast.
Ich habe die beiden Zeilen eingefügt, wie du es vorgeschlagen hast. Aber irgendwie mache ich das falsch. Das Makro bleibt an besagter Stelle stehen.
Könntest du mir bitte das komplette Makro zeigen, wie es sin soll?
Gruß
mike49
Anzeige
AW: Hallo Pierre
28.08.2019 17:54:25
Regina
Hallo mike,
ich habe in diesem Beitrag jetzt etwas den Überblick verloren. Hier der Code der funktionieren müsste. In Deiner Beispieldatei wat kein Blattschutz drauf, daher zunächst von mir nicht berücksichtigt.

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
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
End If
Next
Next
obj_wks.Protect
End If
Next
End If
End Sub
Gruß
Regina
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige