Option
Explicit
Sub
Test()
Dim
rng
As
Excel.Range
With
Worksheets(
"Tabelle1"
)
Set
rng = .Range(
"A1"
, .Cells(.Rows.Count,
"A"
).
End
(xlUp))
End
With
If
rng.Rows.Count > 1
Then
rng.Offset(, 2).FormulaR1C1 =
"=NUMBERVALUE(LEFT(RC2,FIND("
"."
",RC2)-1))"
With
rng.Offset(1, 3).Resize(rng.Rows.Count - 1)
.FormulaR1C1 =
"=R[-1]C+IF(RC[-1]<>R[-1]C[-1],1,0)"
End
With
Else
Call
MsgBox(
"Keine Daten vorhanden."
, vbExclamation)
End
If
End
Sub