AW: Formel einfügen
29.07.2014 13:47:11
fcs
Hallo Mickey,
Makro kann etwa wie folgt aussehen.
Die Summenformel muss du evtl noch etwas anpassen.
Zur Zeit wird die Summe über die Werte in Spalte D gebildet. Für ander Spalten [-3] im Formel-Code anpassen.
Gruß
Franz
Sub SummenFormel_einfuegen()
Dim wks As Worksheet
Dim Zeile As Long, Zeile1 As Long, Zeile_1F As Long, Zeile_L As Long
Dim StatusCalc As Long
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set wks = ActiveSheet
Zeile1 = 2 '1. Zeile für Summenbildung
Zeile_1F = Zeile1
With wks
Zeile_L = .Cells(.Rows.Count, 4).End(xlUp).Row
'Altdaten in Spalte G löschen
.Range(.Cells(Zeile1, 7), .Cells(Zeile_L, 7)).ClearContents
For Zeile = Zeile1 To Zeile_L
If .Cells(Zeile, 4) = "" And .Cells(Zeile + 1, 4) = "" Then
'2 aufeinander folgende Leerzeilen
Zeile = Zeile + 1
'Summe jeweils ab Zeile1
' .Cells(Zeile, 4).Offset(0, 3).FormulaR1C1 = "=SUM(R" & zeile1 & "C[-3]:R[-1]C[-3])"
'Teilsumme der Blöcke
.Cells(Zeile, 4).Offset(0, 3).FormulaR1C1 = _
"=SUBTOTAL(9, R[" & Zeile_1F - Zeile & "]C[-3]:R[-2]C[-3])"
Zeile_1F = Zeile + 1
If .Cells(Zeile, 4).Offset(1, 0) = "" And .Cells(Zeile, 4).Offset(2, 0) = "" Then
'4 aufeinander folgende Leerzeilen
Exit For
Else
End If
End If
Next
End With
With Application
.Calculate
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub