AW: VBA gleitende Zwischensumme einfügen
12.06.2012 20:17:11
fcs
Hallo Romina,
auch ein aufgezeichnetes Makro ist VBA, aber eben mit eingeschränkten Möglichkeiten
Nachfolgend ein Makro, dass beginnend vom Ende der Liste die erforderlichen Leerzeichen und Formeln einfügt.
Gruß
Franz
Sub Zwischensummen()
Dim wks As Worksheet
Dim i As Long, Zeile_L As Long, Zeile_1 As Long
Dim Spalte_1 As Long, Spalte_L As Long
Dim strA As String
Set wks = ActiveSheet
Zeile_1 = 1 '1 Zeile die in den Formeln summiert werden soll
Spalte_1 = 2 'Spalte in der 1. Formeln eingetragen werden sollen
With wks
'letzte Daten-Zeile
Zeile_L = .Cells(.Rows.Count, 1).End(xlUp).Row
'letzte Daten-Spalte
Spalte_L = .Cells(Zeile_L, .Columns.Count).End(xlToLeft).Column
For i = 1 To 4
'Einfügezeile und Text in Spalte A festlegen
Select Case i
Case 1: Zeile_L = Zeile_L + 1: strA = "ENDSUMME"
Case 2: Zeile_L = Zeile_L - 3: strA = "ZWISCHENSUMME"
Case 3: Zeile_L = Zeile_L - 4: strA = "ZWISCHENSUMME"
Case 4: Zeile_L = Zeile_L - 3: strA = "ZWISCHENSUMME"
End Select
'leerzeile einfügen
.Rows(Zeile_L).Insert Shift:=xlShiftDown
'Eintrag in Spalte A
.Cells(Zeile_L, 1) = strA
'Formeln in Leerzeile einfügen
.Range(.Cells(Zeile_L, Spalte_1), .Cells(Zeile_L, Spalte_L)).FormulaR1C1 = _
"=SUBTOTAL(9,R" & Zeile_1 & "C:R[-1]C)-SUMIF(R" & Zeile_1 & "C1:R[-1]C1,""SUMME"",R" _
_
& Zeile_1 & "C:R[-1]C)"
Next i
End With
End Sub