VBA Tipp: Zeichenkette durchlaufen bis nicht mehr nummerisch

Aus DBWiki
Wechseln zu: Navigation, Suche

Problem

Mein Textstring beginnt mit einer Zahl. Wenn diese Zahl zu ende ist, möchte ich den darauf folgenden Text nicht mehr haben. Wie mache ich das?

Beispiele für problematische Textstrings

"143041 "

Lösung

Das geht mit folgender VBA-Funktion:

Public Function ldReadUntilNotNumeric(sIn As String, Optional ByVal lStart As Long = 1, Optional ByVal bAllowDotsCommas As Boolean = False) As Variant
'*************************************************************
'*
'*  Funktion    :        ldReadUntilNotNumeric
'*
'*  Parameter   :        sIn                = EinbabeString
'*                       lStart             = Startposition (Optional)
'*                       bAllowDotsCommas   = Kommas und Punkte erlauben (Wahr oder Falsch - Optional)
'*
'*  Beschreibung:        Durchsucht eine Zeichenkette bis Sie nicht mehr nummerisch ist
'*                       Zurückgegeben wird entweder eine Ganzzahl(Kommas und Punkte erlauben = Falsch oder nicht angegeben)
'*                       oder eine Gkeitkommazahl (bAllowDotsCommas := True)
'*
'*  Rückgabe    :        bei Fehler         = 0
'*                       Erfolgreich        = Zahl (Double oder Long)
'*
'*  Beispielaufruf :     Debug.Print ldReadUntilNotNumeric("143041 ")
'*                       Debug.Print ldReadUntilNotNumeric(sIn:="<span>1.400,13 Stk.", lStart:=7, bAllowDotsCommas:=True)
'*
'*  Erklärung     :      Leerzeichen können so lästig in Textstrings sein!
'*
'*
'*************************************************************
If lStart <> 1 Then
  sIn = Mid(sIn, lStart, Len(sIn) - lStart + 1)
End If
 
For i = 1 To Len(sIn)
 
  If Not IsNumeric(Mid(sIn, i, 1)) Then
      If i = 1 Then
        sOut = "0"
      End If
 
      If bAllowDotsCommas = True And (AscW(Mid(sIn, i, 1)) = 44 Or AscW(Mid(sIn, i, 1)) = 46) Then
 
 
        sOut = sOut & Mid(sIn, i, 1)
 
      Else
       Exit For
      End If
  Else
     sOut = sOut & Mid(sIn, i, 1)
  End If
Next i
 
If bAllowDotsCommas = False Then
  ldReadUntilNotNumeric = CLng(sOut)
Else
  ldReadUntilNotNumeric = CDbl(sOut)
End If
 
 
End Function