Option
Explicit
Sub
Test()
Dim
rngData
As
Excel.Range
With
Worksheets(
"Tabelle1"
)
Set
rngData = .Range(
"B2:B6"
)
End
With
Dim
k_max
As
Long
Dim
k
As
Long
Dim
n
As
Long
k_max = 21
Dim
i
As
Long
For
i = rngData.Cells.Count
To
1
Step
-1
With
rngData.Cells(i)
k = .Value
n = (k \ k_max + 1)
If
n > 1
Then
Call
.Offset(1).Resize(n - 1).EntireRow.Insert(xlShiftDown)
.Resize(n).Offset(0, -1) = .Offset(0, -1)
.Resize(n).Value = k \ n
For
k = 1
To
(k
Mod
n)
.Offset(k - 1).Value = .Offset(k - 1).Value + 1
Next
End
If
End
With
Next
End
Sub