Option Explicit
Sub InBlöcken()
Const tbStart As String = "A1"
Const intbSpalte As String = "B"
Dim lngLetzte As Long
Dim x As Long
Dim lngtbSpalte As Long
Dim rngLetzte As Range
Dim AbZelle As String
Dim NachSpalte As String
lngLetzte = Columns(Range(tbStart).Column).Find("*", Range(tbStart), _
searchOrder:=xlByRows, searchdirection:=xlPrevious).Row
lngtbSpalte = Range(tbStart).Column
Set rngLetzte = Cells(lngLetzte, lngtbSpalte)
For x = 1 To lngLetzte
If Not IsNumeric(Cells(x, lngtbSpalte).Value) And _
Cells(x, lngtbSpalte).Value <> "" Then
AbZelle = Cells(x, lngtbSpalte).Address
NachSpalte = intbSpalte
BerVerdoppelt AbZelle, NachSpalte, rngLetzte
End If
Next x
End Sub
Sub BerVerdoppelt(ByVal Start As String, ByVal inSpalte As String, _
ByVal rngEnde As Range)
Dim rngStart As Range
Dim rngSpalte As Range
Dim rngIst As Range
Dim lngNext As Long
On Error GoTo errorhandler
Set rngStart = Range(Start)
Set rngSpalte = Range(rngStart.Offset(1, 0), rngEnde)
lngNext = Columns(inSpalte).Column - rngStart.Column
For Each rngIst In rngSpalte
If 2 * rngIst.Value = WorksheetFunction.Sum(Range(rngStart, rngIst)) Then
rngIst.Offset(0, lngNext).Value = rngIst.Value
Set rngStart = rngIst.Offset(1, 0)
End If
Next rngIst
Exit Sub
errorhandler:
End Sub