Summe bis Leerzeichen
Laurenz
Obwohl ich schon ein wenig VBA Erfahrung sammeln konnte bin ich heute, bei einem einfachen Problem, nicht weitergekommen und bin auf eure Hilfe angewiesen:
In einem langen Excel-File muss ich Zellen immer bis zu einer Leerzeile addieren.
Zum Bsp:
A1:
A2: 6
A3: 5
A4:
A5: 2
A6: 3
A7: 4
In der Zelle A1 sollte nun 11 stehen (Summe aus A2 und A3) und in Zelle A4 sollte 9 stehen.
Ich habe auch schon ein Codebaustein gefunden der ziemlich gut funktioniert. Allerdings werden die Summen unterhalb gebildet und nicht oberhalb:
Option Explicit
Sub Teilergebnisse_einfügen()
Dim rngStart As Range
Dim rngEnde As Range
Dim rngWeiter As Range
Set rngStart = Cells(1, ActiveCell.Column)
Do Until rngStart.Row = Rows.Count
If IsEmpty(rngStart.Offset(1, 0)) Then
Set rngEnde = rngStart
Else
Set rngEnde = rngStart.End(xlDown)
End If
Set rngWeiter = rngEnde.End(xlDown)
With rngEnde.Offset(1, 0)
.Formula = "=SUBTOTAL(9," & Range(rngStart, rngEnde).Address & ")"
.Font.Bold = True
End With
Set rngStart = rngWeiter
Loop
With rngEnde.Offset(2, 0)
.Formula = "=SUBTOTAL(9," & Range(Cells(1, ActiveCell.Column), rngEnde.Offset(1, 0)). _
Address & ")"
.Font.Bold = True
.Font.ColorIndex = 3
End With
Set rngStart = Nothing
Set rngEnde = Nothing
Set rngWeiter = Nothing
End Sub
Kann mir jemand von euch mitteilen wie ich den obigen Code abändern muss, um die Summe oberhalb zu erhalten?
Vielen Dank und beste Grüsse
Laurenz
Anzeige