Mit dieser Funktion TEXTHELPER_ExtractNumber() erlaubt es Zahlen aus einem übergebenen Text zu ermitteln und gibt die Zahl als Long zurück.
Zum Beispiel ergibt der Aufruf TEXTHELPER_ExtractNumber("chkMyCheckbox16") die Rückgabe von 16 (Long). Dies ist auch ein sinnvoller Anwendungsfall.
Zu beachten gilt, dass eine Null (0) zurückgegeben wird, wenn sich keine Zahl im übergebenen Text befindet. Vielleicht anders lösen....?
Viel Spaß
Code: Alles auswählen
'-------------------------------------------------------------
'
' @purpose: extract every Number in a given String
' meaningfull use for example: get the id
' of a programmatically added Control in a
' Userform or Worksheet from .Name or from
' .Caption
' @params: -
' @author: thowe
' @deprecated: -
' @version: 0.0.1
' @source: inspired by Messud Azlmath
' @module: mod_TEXTHELPER
' @ notes: please remind default return is Zero 0,
' to prevent any error, if the function
' gets a empty paramter (String)
' @date 26.03.2024
'
'-------------------------------------------------------------
' _ _ ___ _ _
' | |__ ___| |__ ( _ ) | |_| |__ _____ _____
' | '_ \ / _ \ '_ \ / _ \/\ | __| '_ \ / _ \ \ /\ / / _ \
' | | | | __/ |_) | | (_> < | |_| | | | (_) \ V V / __/
' |_| |_|\___|_.__/ \___/\/ \__|_| |_|\___/ \_/\_/ \___|
'
'-------------------------------------------------------------
'
' feel free to visit: https:vbasteleien.de
'
'-------------------------------------------------------------
Function TEXTHELPER_ExtractNumber(strText As String) As Long
Dim intPosition As Integer
Dim strTempString As String
Dim strTempCharacter As String
'remove Blankspaces (fronting, trailing)
strTempString = Trim(strText)
'start with the first Character in the given String
intPosition = 1
'cycle through the String until is numeric or not blank/empty
Do While Not (IsNumeric(strTempString) Or (strTempString = ""))
'catch the actual Character in the string
strTempCharacter = Mid(strTempString, intPosition, 1)
'remove every nonnumeric character from the string
If Not IsNumeric(strTempCharacter) Then
strTempString = Trim(Replace(strTempString, strTempCharacter, ""))
Else
'next character
intPosition = intPosition + 1
End If
Loop
'default return, if no string is given is Zero, 0
'this should prevent to run in an error in the Caller
If strTempString = "" Then strTempString = 0
TEXTHELPER_ExtractNumber = CLng(strTempString)
End Function
Mein Schnipsel nutzt die erweiterten Möglichkeiten der Funktion durch Parameter und Optionen. Führt dadurch aber auch zu einem meiner Kenntnis nach in VBA noch nicht gelöstem Problem. Also erst einmal mein Schnipsel [Allg. Modul]:
