Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1708to1712
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Wochenzahlen Makro anpassen

Wochenzahlen Makro anpassen
29.08.2019 12:23:23
mike49
Hallo Leute,
ich habe versucht das Makro für die Einfärbung der Wochenzahlen an eine neue Datei anzupassen. Leider ist mir das misslungen.
Dort heißen außer den gleichen Monatsblättern die beiden Blätter "!" und "Zusammenstellung". Der Bereich wäre hier B9:B39.
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
End If
Next
Next
obj_wks.Protect
End If
Next
End If
Application.ScreenUpdating = True
End Sub
Wie würde das angepasste Makro heißen?
Danke im Voraus für die Hilfe.
Gruß
mike49

20
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Wochenzahlen Makro anpassen
29.08.2019 12:45:51
Pierre
Hallo Mike,
so?
            If obj_wks.Name  "!" And obj_wks.Name  "Zusammenstellung" Then
obj_wks.Unprotect
For Each obj_cell In obj_wks.Range("B9:B39").Cells
Gruß Pierre
AW: Wochenzahlen Makro anpassen
29.08.2019 12:53:30
mike49
Hallo Pierre,
danke, dass du dich nochmals meldest.
Was ist mit der Zeile:
If Target.Column = 3 And Target.Row = 7 Then
Muss die nicht auch angepasst werden?
Gruß
mike49
AW: Wochenzahlen Makro anpassen
29.08.2019 12:55:38
mike49
Ich trage die Jahreszahl im Blatt "!" ein.
AW: Wochenzahlen Makro anpassen
29.08.2019 12:57:20
Rudi
wenn der Code in ! steht und du die Jahreszahl in C7 einträgst nicht.
AW: Wochenzahlen Makro anpassen
29.08.2019 13:02:13
mike49
Upps!
Der Code steht in ! und ich trage die Jahreszahl in B1 ein.
Anzeige
AW: Wochenzahlen Makro anpassen
29.08.2019 12:55:50
Rudi
hallo,
die lng_zaehler-Schleife ist überflüssig. Kann man berechnen.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
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 "!", "Zusammenstellung"
'nix passiert
Case Else
obj_wks.Unprotect
For Each obj_cell In obj_wks.Range("B9:39").Cells
If obj_cell.Value Mod 4 = 1 Then
obj_cell.Font.Color = vbRed
obj_cell.Font.Bold = True
End If
Next
obj_wks.Protect
End Select
Next obj_wks
End If
End Sub
Gruß
Rudi
Anzeige
Danke Leute für die Hilfe . . .
29.08.2019 13:12:35
mike49
. . . so klappt's:
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 = 2 And Target.Row = 1 Then
For Each obj_wks In ThisWorkbook.Worksheets
If obj_wks.Name  "!" And obj_wks.Name  "Zusammenstellung" Then
obj_wks.Unprotect
For Each obj_cell In obj_wks.Range("B9:B39").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
Application.ScreenUpdating = True
End Sub
Gruß
mike49
Anzeige
noch was vergessen . . .
29.08.2019 13:54:56
mike49
. . . jede 4. Woche wird ja farblich hervorgehoben und das klappt auch.
Jetzt gibt es noch diesen Zusatz, dass die Wochenzahlen beim ersten Wochentag im Folgemonat in Klammern dargestellt werden.
Kann man das Makro ergänzen, dass auch diese Wochenzahl in Klammern farblich dargestellt wird, wenn es die jeweils 4. ist?
Beispiel für das Jahr 2020:
Die Woche 5 beginnt am Montag 27.01.2020 und wird ja farblich hervorgehoben.
Am 1.02.2020 wird im Moment die (5) eingtetragen aber nicht farblich hervorgehoben.
Das selbe wäre dann auch am 30.11.2020 bei der Woche 49 der Fall.
Kann man das im Makro integrieren?
Gruß
mike49
Anzeige
Schade . . .
29.08.2019 20:30:37
mike49
. . . es kam keine Rückmeldung. Vermutlich gibt's keine Lösung.
Trotzdem Danke.
Gruß
mike49
AW: Schade . . .
29.08.2019 21:23:39
Pierre
Hallo Mike,
Mir fällt persönlich jetzt nur ein "eigenständiges" SUB ein.
Theoretisch reicht es, die Zellen in der vorhandenen Range aus dem bisherigen Code danach zu untersuchen, ob der Inhalt mit KlammerAuf beginnt und dann die Formatierung wieder zu kopieren.
Ich schreibe schon Mal eine Zeile, die so oder so ähnlich da rein müsste. Ich melde mich morgen nochmal dazu, wenn es okay ist? Hab jetzt nur das Handy zur Hand.
If Left(Range("deinerange"), 1) = "(" Then
Ist hoffentlich kein großer Aufwand mehr, das in das laufende Makro zu bringen.
Gruß Pierre
Anzeige
AW: Schade . . .
30.08.2019 10:01:10
mike49
Hallo Pierre,
danke, dass du dich nochmals gemeldet hast. Es wäre immer nur A5 zu überprüfen, ob dort die jeweils 4. Woche in Klammern steht.
Eine weitere Sache ist mir noch aufgefallen:
Das Jahr 2020 hat 53 Wochen. Die 53. Woche ist die 4. Woche und wird richtigerweise farblich hervorgehoben.
Wenn ich jetzt das Jahr 2021 wähle,, sollte in A5 beim Januarblatt die Woche 53 in Klammern farblich hervorgehoben sein.
Danach müsste - wegen den 4er-Schritten - die 4. Woche , die 8. Woche usw. farblich hervorgehoben werden.
Das erfolgt nicht und es werden weiterhin die Wochen 1,5,9 usw. farblich hervorgehoben.
Es würde mich freuen, wenn es auch hierfür eine Lösung gäbe.
Gruß
mike49
Anzeige
Also...
30.08.2019 11:42:53
Pierre
Hallo Mike,
leider kann ich dir nur insofern helfen, als dass ich jetzt weiß, dass die genannte Zeile stimmt.
If Left(Cells(5, 1), 1) = "(" Then
Cells(5, 1).Font.ColorIndex = 50
End If
Alternativ zu Cells(5, 1), kannst du auch wie erst angegeben Range("A5") schreiben.
Sorry, mehr kann ich leider nicht tun.
gruß Pierre
AW: Also...
30.08.2019 12:05:58
mike49
Hallo Pierre,
ich habe das Makro jetzt so abgeändert. Aber leider funktioniert die Erweiterung nicht.Bleibt die geschlossene Klammer ")" unberücksichtigt? Die Wochenzahl wird ja so dargestellt: (1).
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
Application.ScreenUpdating = True
End Sub

Gruß
mike49
Anzeige
AW: noch was vergessen . . .
30.08.2019 12:14:58
Rudi
Hallo,
If --replace(replace(obj_cell.Value,"(",""),")","") = lng_zaehler Then
Gruß
Rudi
AW: noch was vergessen . . .
30.08.2019 12:38:31
mike49
Hallo Rudi,
sorry, aber das kriege ich nicht hin. Wie würde dein Vorschlag hierbei aussehen?
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
Gruß
mike49
Application.ScreenUpdating = True
End Sub

Anzeige
Hallo Rudi . . .
31.08.2019 08:04:19
mike49
. . . ich dachte, du meldest dich zu meiner Frage nochmals?
Gruß
mike49
Hallo Rudi . . .
31.08.2019 08:07:35
mike49
. . . ich dachte, du meldest dich nochmals, da ich nicht weiß, wie ich die Zeile enfügen soll?
Gruß
mike49
Warum machst du eigentlich immer...
30.08.2019 08:41:13
SF
...einen neuen Thread auf und sagst im alten nicht Bescheid?
Gruß,
steve1da
AW: Warum machst du eigentlich immer...
30.08.2019 10:12:24
mike49
Hallo SF,
sorry,,das war nicht beabsichtigt. Da ich einen „Nachtrag“ unmittelbar nach Versenden einer Antwort geschickt habe, glaubte ich, der Thread sei noch nicht geschlossen und man müsse keinen neuen aufmachen.
Gruß
mike49
AW: Warum machst du eigentlich immer...
30.08.2019 10:12:24
mike49
Hallo SF,
sorry,,das war nicht beabsichtigt. Da ich einen „Nachtrag“ unmittelbar nach Versenden einer Antwort geschickt habe, glaubte ich, der Thread sei noch nicht geschlossen und man müsse keinen neuen aufmachen.
Gruß
mike49
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige