Sub Baumdurchmesser()
Dim rngCell As Excel.Range
Dim blnErr As Boolean
Dim n As Long
Set rngCell = Worksheets("Tabelle1").Range("B1")
On Error GoTo Final
With rngCell
.Value = Mid$(.Value, InStr(.Value, "c") + 1, InStr(.Value, "-") - InStr(.Value, "c") - 1)
Call .TextToColumns(rngCell, xlDelimited, Other:=True, OtherChar:="+")
End With
On Error GoTo 0
Do
n = InStr(1, rngCell.Value, "*")
If n > 0 Then
On Error Resume Next
n = Left(rngCell.Value, n - 1)
If Err.Number <> 0 Then
On Error GoTo 0
blnErr = True
n = 1
ElseIf n > 1 Then
rngCell.Value = Mid(rngCell.Value, InStr(1, rngCell.Value, "*") + 1)
rngCell.Value = rngCell.Value * 1
On Error GoTo 0
Call rngCell.Resize(, n - 1).Offset(, 1).Insert(xlShiftToRight)
rngCell.Resize(, n).Value = rngCell.Value
End If
Else
n = 1
End If