'Die eigentliche Ermittlung der Werte
'Die Funktion erwartet folgende Werte:
'vCell: Der gesamte, zu durchsuchende Text
'vStoff: Nach welchem Gegenstand wird gesucht
Function GetWerte(ByVal vCell$, ByVal vStoff$)
'Dimensionierung
Dim sStelle%, pStelle%
'Ermittle, an welcher Stelle der Gegenstand als Wort steht
sStelle = InStr(vCell, vStoff) - 1
'Wenn vorhanden
If sStelle > 0 Then
'Leerzeichen beachten
If Mid(vCell, sStelle, 1) = Chr(32) Then sStelle = sStelle - 1
'Nach dem Leerzeichen vor der Zahl suchen
pStelle = InStrRev(vCell, " ", sStelle) + 1
'und die Zahl auslesen und als Rückgabewert setzen
GetWerte = Mid(vCell, pStelle, sStelle - pStelle + 1)
Else:
'Rückgabewert 0 (Nicht vorhanden)
GetWerte = 0
End If
End Function