Ok, dann neuer Versuch für heute. Da wo jetzt in Spalte A das Wort Summe auftaucht, beginnt die Summe (hoffe mal es kommt nur ein mal vor :-) ). Anbei auch wieder ein Bild. Da wo Summe in Spalte A steht wird in E eingetragen - egal wo das Steht. Wieder 4 Summen untereinander für die 4 Versätze von oben. MIt dem Eintragen mehr als eins war gemeint, wenn du gleichzeitig mehrer Zellen änderst (also 2 bis x Zellen kopierne und einfügen). Dann passiert nix. Könnte man aber auch noch beheben - wird dann aber ggf. umfangreicher. :-) VG
Also das Bild
der Code dazu,
Private Sub Worksheet_Change(ByVal Target As Range)
Dim spalte As Long
Dim zeilesum As Long
Dim versatz As Long
Dim letztezeile As Long
Dim zeile As Long
Dim summe As Long
Dim l As Long
zeilesum = Application.Match("Summe", ActiveSheet.Columns(1), 0)
'nur wenn eine Zelle geändert wurde ausführen
If Target.Count = 1 Then
'prüfen ob Spalte E bis M
If Not Intersect(Target, ActiveSheet.Columns("E:M")) Is Nothing Then
'warum eigentlich in Spalte C gezählt -> sollte das ggf. Spalte B also 2 sein
letztezeile = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
'nur wenn ab Zeile 5 bis Zeile vor der Summe
If Target.Row > 4 And Target.Row < zeilesum Then 'hier noch die Änderung zur Prüfung
nächstfreieZellefipa = 7
For zeile = 5 To letztezeile
Cells(zeile + 1, 2).Value = Application.WorksheetFunction.Sum(Range(Cells(zeile, 5), Cells(zeile + 1, nächstfreieZellefipa - 2)))
zeile = zeile + 3
Next
'jetzt summieren
'jetzt die Spalte summieren
spalte = Target.Column
summe = 0
'jeden vierten wert addieren
versatz = (Target.Row Mod 4)
If versatz = 0 Then versatz = 4
For l = 4 + versatz To zeilesum - 1 Step 4
summe = summe + ActiveSheet.Cells(l, spalte)
Next l
'jetzt eintragen
versatz = (Target.Row Mod 4 - 1)
If versatz = -1 Then versatz = 3
ActiveSheet.Cells(zeilesum + versatz, spalte) = summe
End If
End If
End If
End Sub
|