'entwickelt von Winfried Radner
'e-mail: Wolf.W.Radzinski@onlinehome.de
'Benutzung frei - ohne Gewähr

Public Function extract_zahl(alter_Text As Range) As Variant
On Error Resume Next
extract_zahl = 0
If Len(alter_Text.Text) > 0 Then
    pos = 1: i = 0: anfang = False: ende = False
    Do
       ziffer = Mid(alter_Text.Text, pos + i, 1)
       Select Case ziffer
         Case "0" To "9", ".", ",", "-", "+": pos = pos + i
                                              anfang = True
         Case Else: i = i + 1
       End Select
    Loop Until anfang Or i = Len(alter_Text.Text)
    i = 1
    Do
      ziffer = Mid(alter_Text.Text, pos + i, 1)
      Select Case ziffer
        Case "0" To "9", ".", ",": i = i + 1
        Case Else: ende = True
      End Select
    Loop Until ende Or i + pos > Len(alter_Text.Text)
    extract_zahl = CDbl(Mid(alter_Text.Text, pos, i))
End If
End Function

'alternative Funktion

Function WerteAus(Ausdruck)
zahl = False: ende = False
Dim sVar As String, i As Integer
    For i = 1 To Len(Ausdruck.Value)
        Select Case Mid(Ausdruck, i, 1)
            Case Application.International(xlDecimalSeparator):
                sVar = sVar + ","
            Case Application.International(xlThousandsSeparator):
                sVar = sVar + "."
            ' Case " ": 'diese Zeile einfügen, wenn Leerzeichen Teil einer Zahl sein kann
            Case Else:
                If InStr(1, "^0123456789,()+*-/", Mid(Ausdruck, i, 1)) And Not ende Then
                    sVar = sVar + Mid(Ausdruck, i, 1)
                    zahl = True
                Else
                    If zahl Then ende = True 'so wird nur die erste Zahl genommen
                End If
         End Select
   Next
   WerteAus = CDbl(sVar) 'Evaluate(sVar)
End Function