Office: Summieren im Kalender

Hallo erstmal,
für einen formatierten Kalender möchte ich eine Summenbildung von Werten, die in einer bestimmten Kalenderwoche liegen.
z. b
KW1 KW1 KW1 KW1 KW1 KW1 KW1 KW2 usw.
Mo Di Mi Do Fr Sa So Mo
10 12 13 15 16 10 Summe KW 1 20


Da sich in der Spalte A jedes Jahr die Kalenderwochen ändern benötige ich eine schlaue Formel

 

Hallo!

In Spalte A kann ich nix erkennen, was sich auf Kalenderwochen beziehen würde...
Wenn du aber mit "Spalte A" eigentlich "Zeile 8" meinst, musst du den Satz wohl so fortführen:

...muss es (leider) per VBA passieren, da ich ja sonst meine Formeln in alle Zellen eintragen müsste und beim Eintragen der realen Werte immer wieder überschreiben würde.

(Es sei denn, es ist eine Option für dich, die Summierung in einer Zelle außerhalb des eigentlichen Kalenders durchzuführen.)

Das Ereignis dafür könnte vielleicht so aussehen:

Code:

Private Sub Worksheet_Calculate()
Dim i As Byte, j As Byte
Application.EnableEvents = False
For i = 5 To 35
If Cells(9, i).Text = "So" Then
With WorksheetFunction
For j = 0 To 27 Step 3
Cells(12 + j, i) = .Sum(Range(Cells(12 + j, i - 1), Cells(12 + j, .Max(5, i - 6))))
Next j
End With
End If
Next i
Application.EnableEvents = True
End Sub

 

klappt prima auch wenn ich nicht die Formel verstehe
Allerdings kommt jetzt noch ein Problem hinzu:
wie muß ich die Formel ändern, wenn ich in der Zelle unterhalb der jetzigen Summe nochmal eine Summierung benötige

 

Hallo!

Cells(12 + j + 1, i) = .Sum(Range(Cells(12 + j, i - 1), Cells(12 + j, .Max(5, i - 6))))

schreibt die Summe eine Zeile tiefer.

 

hat prima geklappt;

besten Dank

 

Übertrag aus Vormonat

Hallo,

benötige noch eine Erweiterung der o. a. Formel/Code:

da sich die letzten Werktage im Januar befinden, muß sich die Addition am ersten Sonntag im Februar ergeben. Wäre schön, wenn du das hinbekommen könntest.

Gruß sunflyer

 

Hallo!

Ich hoffe, dass das hier funktioniert, sonst musst du weiterbasteln:

Code:

Dim i As Byte, j As Byte, Übertrag1, Übertrag2
Application.EnableEvents = False
On Error Resume Next
For i = 5 To 15
If Cells(9, i).Text = "So" Then
With WorksheetFunction
For j = 0 To 16 Step 4
If i < 11 Then
Übertrag1 = .Sum(Range(ActiveSheet.Previous.Rows(9).Find(What:="Mo", LookIn:=xlValues, _
SearchDirection:=xlPrevious).Offset(j + 3, 0), ActiveSheet.Previous.Cells(j + 12, 99)))
Übertrag2 = .Sum(Range(ActiveSheet.Previous.Rows(9).Find(What:="Mo", LookIn:=xlValues, _
SearchDirection:=xlPrevious).Offset(j + 4, 0), ActiveSheet.Previous.Cells(j + 13, 99)))
Else: Übertrag1 = 0: Übertrag2 = 0
End If
Cells(12 + j, i) = Übertrag1 + .Sum(Range(Cells(12 + j, i - 1), Cells(12 + j, .Max(5, i - 6))))
Cells(13 + j, i) = Übertrag2 + .Sum(Range(Cells(13 + j, i - 1), Cells(13 + j, .Max(5, i - 6))))
Next j
End With
End If
Next i
Application.EnableEvents = True

 

hat bestens geklappt

vielen Dank für die schnelle Hilfe