====== [VBA] Cast Funktionen ======
//Eine Sammlung von diversen Cast-Funktionen//
VBA bietet beschränkte möglichkeiten zum Casten von Variablen. So muss man jedesmal, wenn man mit einem
Variant arbeiten muss, diesen zuerst mit NZ parsen. Auch das Extrahieren von Zahlen innerhalb von
Texten müssen jedesmal von Hand aus programmiert werden.
Darum habe ich mir eigene Cast-Funktionen erstellt. Um die Performance nicht allzufest in die Knie zu zwingen,
wird zuerst versucht mittels Standart-VBA Befehlen die Zahl herauszulösen. Erst wenn das nicht geht, kommt
RegExp in den Einsatz.
===== Anforderungen ====
Die Cast-Funktionen greiffen auf andere Funktionen zu, die ich bereits erstellt habe.
=== rx-Funktionen: rx_like() & rx_choose() ===
Für die Nummer-Cast-Funktionen verwende ich rx_like und rx_choose aus [[vba:functions:rx:index#version_mit_cache|[VBA] RegExp Functions mit Cache]]
=== strToDate() ===
Für [[#castDate()]] wird die Funktion [[.:strtodate]] verwendet
=== print_r() ===
[[:vba:functions:print_r:]] wird nur für die Beispiele gebraucht. Diese Funktion wird im Einsatz nicht gebraucht
===== Vorhandene Funktionen =====
Bisher sind die folgenden Funktionen umgesetzt
***castDbl()** Castet in ein Double
***castInt()** in ein Integer
***castLng()** in ein Long(Integer)
***castDate()** in ein Date
***castStr()** in ein String
===== castInt(), castLng(), castDbl() =====
==== Definition ====
Diese Definition ist für die anderen Nummer Cast-Funktionen etwa gleich
Public Function castDbl( _
ByRef iVar As Variant, _
Optional ByVal iMatchIndex As Integer = 1, _
Optional ByVal iDefaultValue As Double = 0 _
) As Double
=== Parameterliste ===
***iVar ** Wert der gecastet werden soll
***//iMatchIndex //** Bei einem String mit mehreren Zahlen ist dies der Index, welche Zahl genommen werden soll
***//iDefaultValue //** Wert, welcher im Fehlerfall zurückgegeben werden soll
=== Rückgabewert ===
Ein Datum. Im Fall von Null den Defualt-Wert. Wenn bei einem Text keine Zahl rin ist, wird ebenfalls der Default_wert zurückgegeben
==== Beispiele ====
' Normaler Cast
print_r castDbl(" 123.45")
123.45
'Casten von Null
print_r castDbl(Null)
0
'Wieder NUll, aber als Standart-Wert -1
print_r castDbl(Null,,-1)
-1
'Casten des ersten Wertes aus einem Text
print_r castDbl("Hans kauft 12 Eier zu 3.45 Franken")
12
'Ein String ohne Zahlen, jedoch mit einem Standart-Wert
print_r castDbl("Hans kauft Eier",,24)
24
'Casten des 2ten Wertes aus demselben Text
print_r castDbl("Hans kauft 12 Eier zu 3.45 Franken", 2)
3.45
'Und noch 2 Beispiele, wenn die übergeben Variable ein Objekt ist
print_r castDbl(New FileSystemObject)
0
print_r castDbl(New FileSystemObject, , -1)
-1
===== castStr() =====
==== Definition ====
Der castStr() ist eigentlich nicht viel mehr als ein cStr() mit nz() kombiniert
Public Function castStr( _
ByRef iVar As Variant, _
Optional ByVal iDefaultValue As String = vbNullString _
) As String
=== Parameterliste ===
***iVar ** Wert der gecastet werden soll
***//iDefaultValue //** Wert, welcher im Fehlerfall zurückgegeben werden soll
=== Rückgabewert ===
Ein String. Fall von Null, den Default-Wert
==== Beispiele ====
'Eine Zahl zu einem String
print_r castStr(12.5)
'12.5'
'Ein Datum
print_r castStr(Now)
'06.01.2014 14:21:44'
'Null
print_r castStr(Null)
''
print_r castStr(Null, "EMPTY")
'EMPTY'
===== castDate() =====
==== Definition ====
Diese Funktion verwendet eine Kombination zwischen [[[[.:strToDate|strToDate()]] und nz()
Public Function castDate( _
ByRef iVar As Variant, _
Optional ByVal iFormat As String = vbNullString, _
Optional ByVal iDefaultValue As Date = 0, _
Optional ByVal iTruncToDate As Boolean = True _
) As Date
=== Parameterliste ===
***iVar ** Wert der gecastet werden soll
***//iFormat //** Formatierung von iVar gem. [[.:strToDate]]
***//iDefaultValue //** Wert, welcher im Fehlerfall zurückgegeben werden soll
***//iTruncToDate //** FLag, ob die Uhrzeit abgeschnitten werden soll
=== Rückgabewert ===
Ein Datum. Wenn iVar kein gültiges Datum ergibt, dann wird iDefaultValue zurückgegen. Wenn Dieser Wert 0 ist, wird
das aktuelle Datum zurückgegeben
==== Beispiele ====
' Einfacher Datumsstring
print_r castDate("6.1.14")
06.01.2014
'Null -> Sysdate ohne Uhrzeit
print_r castDate(Null)
06.01.2014
'Null -> Sysdate mit Uhrzeit
print_r castDate(ivar:= Null, iTruncToDate := false)
06.01.2014 14:15:45
'String in einem anderen Datumsformat
print_r castDate("20140106", "yyyymmdd")
06.01.2014
'Datum
print_r castDate(Now)
06.01.2014
print_r castDate(Now,,,False)
06.01.2014 14:38:36
===== Code =====
'-------------------------------------------------------------------------------
'File : Cast
' Copyright mpl by ERB software
' All rights reserved
' http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/cast
'Environment : VBA 2007 +
'Version : 1.1
'Name : Cast
'Author : Stefan Erb (ERS)
'History : 31.12.2013 - ERS - Creation
' 06.01.2014 - ERS - Funktionen castStr() und castDate() hinzugefügt
'Requiered : Rx-Functions: http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/rx/index
' strToDate(): http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/strtodate
'-------------------------------------------------------------------------------
Option Explicit
'/**
' * Pattern um ein Double in einem String zu finden
'*/
Private Const C_NUM_PATTERN As String = "\d+\.?\d*"
'/**
' * Die Reihenfolge der Cast-Versuche
' */
Private Enum castTrySteps
tryVBACast = 0 'Casten über die VBA-Eigenen Funktionen
tryRegEx = 1 'Casten über Reguläre Ausdrüke
setDefault = 2 'Setze den Default-Wert
End Enum
'/**
' * Castet Irgendwas zu einem String
' * Eigentlich macht diese Funktioen nicht viel mehr als ein NZ() und ein cStr()
' * @param Variant Wert der gecastet werden soll
' * @param String Optional: Wert, welcher im Fehlerfall zurückgegeben werden soll
' * @return String
' */
Public Function castStr( _
ByRef iVar As Variant, _
Optional ByVal iDefaultValue As String = vbNullString _
) As String
On Error GoTo ERR_H
'Zuerst mit den VB-Funktionen versuchen
castStr = CStr(Nz(iVar, iDefaultValue))
Exit Function
ERR_H:
castStr = iDefaultValue
End Function
'/**
' * Castet Irgendwas zu einem Datum
' * Requiered: strToDate http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/strtodate
' * @param Variant Wert der gecastet werden soll
' * @param Date Das Format. Als Standart ist das Systemdatumsformat
' * @param Boolean Auf Datum schneiden
' * @return Date
' */
Public Function castDate( _
ByRef iVar As Variant, _
Optional ByVal iFormat As String = vbNullString, _
Optional ByVal iDefaultValue As Date = 0, _
Optional ByVal iTruncToDate As Boolean = True _
) As Date
Dim defaultValue As Date: defaultValue = IIf(iDefaultValue = 0, Now, iDefaultValue)
On Error GoTo ERR_H
'Zuerst mit den VB-Funktionen versuchen
castDate = strToDate(Nz(iVar, defaultValue), iFormat)
If iTruncToDate Then castDate = truncDate(castDate)
Exit Function
ERR_H:
castDate = defaultValue
If iTruncToDate Then castDate = truncDate(castDate)
End Function
'/**
' * Copyright mpl by ERB software | http://wiki.yaslaw.info
' * Schneidet die Zeit ab
' * @param Date Datum [+ Zeit]
' * @retrun Date Datum ohne Zeit
' */
Private Function truncDate(Optional ByVal iDateTime As Date) As Date
truncDate = DateSerial(Year(iDateTime), Month(iDateTime), Day(iDateTime))
End Function
'/**
' * Castet Irgendwas zu einem Double
' * @param Variant Wert der gecastet werden soll
' * @param Integer Optional: Bei einem String mit mehreren Zahlen ist dies der Index, welche Zahl genommen werden soll
' * @param Double Optional: Wert, welcher im Fehlerfall zurückgegeben werden soll
' * @return Double
' */
Public Function castDbl( _
ByRef iVar As Variant, _
Optional ByVal iMatchIndex As Integer = 1, _
Optional ByVal iDefaultValue As Double = 0 _
) As Double
Dim tryStep As castTrySteps: tryStep = tryVBACast
On Error GoTo ERR_H
TRY_1__WITH_VBA_CAST:
'Zuerst mit den VB-Funktionen versuchen
castDbl = CDbl(Nz(iVar, iDefaultValue))
Exit Function
TRY_2__WITH_REGEX:
'Ansonsten mittels RegEx den ersten Wert ermitteln
If Not rx_like(C_NUM_PATTERN, iVar) Then GoTo TRY_3__SET_DEFAULT
castDbl = CDbl(rx_choose(C_NUM_PATTERN, iVar, iMatchIndex))
Exit Function
TRY_3__SET_DEFAULT:
'Es handelt sich um irgendwas komischen. Ein UDT, Ein Objekt oder sontwas.
castDbl = iDefaultValue
Exit Function
ERR_H:
'Es ist ien Fehler aufgetretten. Ergo versuchen wir es mit der nächsten Variante
Select Case tryStep
Case tryVBACast: tryStep = tryStep + 1: Resume TRY_2__WITH_REGEX
Case tryRegEx: tryStep = tryStep + 1: Resume TRY_3__SET_DEFAULT
End Select
End Function
'/**
' * Castet Irgendwas zu einem Integer
' * @param Variant Wert der gecastet werden soll
' * @param Integer Optional: Bei einem String mit mehreren Zahlen ist dies der Index, welche Zahl genommen werden soll
' * @return Integer
' */
Public Function castInt( _
ByRef iVar As Variant, _
Optional ByVal iMatchIndex As Integer = 1, _
Optional ByVal iDefaultValue As Double = 0 _
) As Double
Dim tryStep As castTrySteps: tryStep = tryVBACast
On Error GoTo ERR_H
TRY_1__WITH_VBA_CAST:
castInt = CInt(Nz(iVar, iDefaultValue))
Exit Function
TRY_2__WITH_REGEX:
If Not rx_like(C_NUM_PATTERN, iVar) Then GoTo TRY_3__SET_DEFAULT
castInt = CInt(rx_choose(C_NUM_PATTERN, iVar, iMatchIndex))
Exit Function
TRY_3__SET_DEFAULT:
castInt = iDefaultValue
Exit Function
ERR_H:
Select Case tryStep
Case tryVBACast: tryStep = tryStep + 1: Resume TRY_2__WITH_REGEX
Case tryRegEx: tryStep = tryStep + 1: Resume TRY_3__SET_DEFAULT
End Select
End Function
'/**
' * Castet Irgendwas zu einem Long
' * @param Variant Wert der gecastet werden soll
' * @param Integer Optional: Bei einem String mit mehreren Zahlen ist dies der Index, welche Zahl genommen werden soll
' * @return Long
' */
Public Function castLng( _
ByRef iVar As Variant, _
Optional ByVal iMatchIndex As Integer = 1, _
Optional ByVal iDefaultValue As Long = 0 _
) As Long
Dim tryStep As castTrySteps: tryStep = tryVBACast
On Error GoTo ERR_H
TRY_1__WITH_VBA_CAST:
castLng = CLng(Nz(iVar, iDefaultValue))
Exit Function
TRY_2__WITH_REGEX:
If Not rx_like(C_NUM_PATTERN, iVar) Then GoTo TRY_3__SET_DEFAULT
castLng = CLng(rx_choose(C_NUM_PATTERN, iVar, iMatchIndex))
Exit Function
TRY_3__SET_DEFAULT:
castLng = iDefaultValue
Exit Function
ERR_H:
Select Case tryStep
Case tryVBACast: tryStep = tryStep + 1: Resume TRY_2__WITH_REGEX
Case tryRegEx: tryStep = tryStep + 1: Resume TRY_3__SET_DEFAULT
End Select
End Function
===== Vergleich mit anderen Cast-Funktionen für Double =====
{{section>.:compairetodoublefunctions#Vergleichstabelle&noheader&firstseconly}}