Option Explicit
Sub Test()
Dim i As Long
For i = 1 To 5
With Cells(i, "H")
.Offset(, 1).Formula = Remove1stNumeric(.Cells(1))
End With
Next
End Sub
Public Function Remove1stNumeric(ByVal Expression As Variant) As Variant
Dim col As VBA.Collection
Dim expr As String
Dim i As Long
Dim j As Long
If IsObject(Expression) Then
If Expression Is Nothing Then Exit Function
If TypeOf Expression Is Excel.Range Then
expr = Expression.Formula
Else
Exit Function
End If
Else
expr = CStr(Expression)
If Left$(expr, 1) <> "=" Then expr = "=" & expr
End If
Set col = New VBA.Collection
j = 2
col.Add "="
For i = 1 To Len(expr) + 1
Select Case Mid$(expr, i, 1)
Case "+", "-", "*", "/"
col.Add Mid$(expr, j, i - j)
col.Add Mid$(expr, i, 1)
j = i + 1
Case ""
col.Add Mid$(expr, j, i - j)
End Select
Next
For i = 1 To col.Count
If IsNumeric(col(i)) Then
If i = 2 Then
col.Remove 2
col.Remove 2
ElseIf i = col.Count Then
col.Remove col.Count
col.Remove col.Count
Else
If (col(i - 1) = "-" Or col(i - 1) = "+") _
And (col(i + 1) = "-" Or col(i + 1) = "+") _
Then
col.Remove i - 1
col.Remove i - 1
Else
MsgBox "Formel: '" & expr & "'" & vbNewLine & _
"Wert := " & col(i) & vbNewLine & vbNewLine & _
"Wert befindet sich zwischen anderen Termen im Produkt/Division." & vbNewLine & _
"Was nun!?", _
vbExclamation
Remove1stNumeric = CVErr(XlCVError.xlErrNA)
Exit Function
End If
End If
Exit For
End If
Next
expr = ""
For i = 1 To col.Count
expr = expr & col(i)
Next
Remove1stNumeric = expr
End Function