Wie im unteren Beispiel,möchte ich gerne nach jeden Sonntag eine Zelle automatisch einfügen.
Mit der Summenbildung.
Könnte mir BITTE dabei jemand helfen ?
Danke Heinz
Tabelle1 | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Tabelle1 | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Sub Zwischensumme()
Dim rng As Range
Dim lngZeileAnf As Long
For Each rng In Range("B6:B" & Range("B65536").End(xlUp).Row)
If WeekDay(rng) = 1 Then
rng.Offset(1, 0).EntireRow.Insert
lngZeileAnf = rng.Offset(0, 1).End(xlUp).Offset(1, 0).Row
If rng.Offset(0, 1).End(xlUp).Row = 1 Then lngZeileAnf = lngZeileAnf - 1
rng.Offset(1, 1).FormulaLocal = "=Summe(C" & lngZeileAnf & ":C" & rng.Row & ")"
End If
Next rng
End Sub
Sub Sonntag()
Dim SP#, Such$, LR%, TB1, I#, M%
'anpassen ******
Set TB1 = Sheets("Jänner")
SP = 2 'Spalte mit den Wochentagen
Such = "So"
LR = TB1.Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
For I = LR To 1 Step -1
If Cells(I, SP).Text = Such Then
Rows(I + 1).Insert
If I < 7 Then
M = I
Else
M = 7
End If
Cells(I + 1, SP + 1).FormulaR1C1 = "=Sum(R[-" & M & "]C:R[-1]C)"
End If
Next
Fehler:
If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
End Sub
Sub Montag()
Dim SP#, Such$, LR%, TB1, I#, M%, Z1%
'anpassen ******
Set TB1 = Sheets("Jänner")
SP = 2 'Spalte mit den Wochentagen
Such = "Fr"
Z1 = 6 'erste Zeile mit Daten
LR = TB1.Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
For I = LR To Z1 Step -1
If Cells(I, SP).Text = Such Then
Rows(I + 1).Insert
If I < 5 + Z1 Then
M = I - Z1 + 1
Else
M = 5
End If
Cells(I + 1, SP + 1).FormulaR1C1 = "=Sum(R[-" & M & "]C:R[-1]C)"
Range(Cells(I + 1, 1), Cells(I + 1, 15)).Interior.ColorIndex = 34
End If
Next
Fehler:
If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
End Sub