@Gast7777: Ich würd' mal sagen, dass war nur ein einfaches Beispiel gewesen. ;-)
Beispiel-Tabelle zum Makro unten:
|
H |
1 |
=A2+B2+100 |
2 |
=A2+B2-100 |
3 |
=(A2+B2)*0,5 |
4 |
=100+A2+B2 |
5 |
=A2-100*B2 |
Option Explicit
Sub Test()
Dim i As Long
For i = 1 To 5
With Cells(i, "H")
'output next to source
.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
'get formula
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
'splitting up formula
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
'remove first numeric value only
For i = 1 To col.Count
If IsNumeric(col(i)) Then
If i = 2 Then 'first
col.Remove 2
col.Remove 2
ElseIf i = col.Count Then 'last
col.Remove col.Count
col.Remove col.Count
Else 'mid
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 'first numeric value got removed
End If
Next
expr = ""
For i = 1 To col.Count
expr = expr & col(i)
Next
Remove1stNumeric = expr
End Function
|