version=1.3.0 vdate=19.10.2015 fname=cast_cvalue.bas ns=%NAMESPACE% fpath=/vba/cast {{keywords>vba,castfunction}} ====== [VBA] cValue(), cV() ====== //cValue versucht einen String in ein Nativetyp zu casten.// ==Version %%version%% - %%vdate%%== Die Funktion wird zum Beispiel in [[vba:cast:cdict]] verwendet. {{%%fname%%|Download %%fname%% (V-%%version%%)}} Ich habe 2 Versionen. cValue() ist ein ausführlicher, lesbarer Code der sich gut eignet um als eigenständige Funktion verwendet zu werden. \\ cV() ist auf das nötigste gekürzt und gestutzt. Sie hat die gleiche Funktionalität wir cValue(), ist jedoch vom Code her viel kompakter. Ich verwende vV() in verschiedenen anderen Funktionen. ===== cValue() ===== ==== Definition ==== Variant = cValue(String [,cvHandling]) Public Function cValue( ByVal iString As String, Optional ByVal iHandling As cvHandling ) As Variant Public Enum cvHandling cvhNullTextAsNull = 2 ^ 0 'Der Text Null ohne Delemiter wird als Wert Null intepretiert cvhEmptyAsNull = 2 ^ 1 'Ein leerer String wird als Null intepretiert End Enum ==== Beispiel ==== > Für die Ausgabe der Resultate verwendete ich die Funktion [[:vba:functions:print_r:]]. === Zahlen === 'Ein Integer asl Text -> Integer d cValue("12345") 12345 'Wenn die Zahlen grösser sind, wird daraus ein Long, bzw. ein Decimal d cValue("1234567890") 1234567890 d cValue("12345678901234567890") 12345678901234567890 'Dito für eine Gleitkommazahl -> Double d cValue("123.45") 123.45 'Ist die Zahl mit Delemiter umgeben, wird sie als String zurpückgegeben d cValue("'123'") '123' === Datum === Es wird mit cDate geparst. Dieses kann sich Systemabhängig anders verhalten 'Datum ohne Delemiter d cValue("25/1/2014") 25.01.2014 'Datum mit Delemiter d cValue("#1-25-2014#") 25.01.2014 === Strings === 'Ein Text ohne Delemiter d cValue("ABC") 'ABC' 'Ein Text mit Delemiter. Als delemited Text gelten die drei folgenden Pattern: '..', "..", [..] d cValue("'abc'") 'abc' == Thematik NULL == 'Leerer Text d cValue("") '' 'Leerer Text mit dem Flag, diesen als Null zu werten d cValue("", cvhEmptyAsNull) 'Der Text Null d cValue("Null") 'Null' 'Der Text Null mit dem Flag, diesen als Null zu werten d cValue("Null", cvhNullTextAsNull) 'Der Text Null in Delemiter mit dem Flag, diesen als Null zu werten d cValue("'Null'", cvhNullTextAsNull) 'Null' ===== cV() ===== ==== Definition ==== Variant = cV(Variant [,flags]) Public Function cV( ByVal iValue As Variant, Optional ByVal iFlags As String ) As Variant **iFLags** ist ein String, der das Verhalten cV() steuert. Die Flags sind3 Buchstaben de kombiniert werden können. ***s** Der Text Null ohne Delemiter wird als Wert Null intepretiert ***e** Ein leerer String wird als Null intepretiert ***b** Boolean-Text wird als Boolean intepretiert ***d** Bei Delemited Strings den Delemiter entfernen. ' oder " gelten als Delemiter ==== Beispiel ==== > Für die Ausgabe der Resultate verwendete ich die Funktion [[:vba:functions:print_r:]]. 'String zu Zahl d cV("1234.5") 01.05.1234 'Text Null d cV("NULL") 'NULL' 'Text Null intepretieren d cV("NULL", "n") 'Leerer String d cV("") 'Empty als Null zurückgeben d cV("", "e") 'Boolean als Wert d cV("TRUE") 'TRUE' 'Boolean parsen d cV("TRUE", "b") True 'Kombioniert. Nicht alle Flags kommen unbedigt zum tragen ' Der String ist mit ' Als Deleimiter mitgeliefert d cV("'NULL'", "nd") 'NULL' ===== Code ===== ==== Ganzes Modul ==== ==== Nur Kurzversion cV ==== '/** ' * Dies ist die Minimalversion von cValue (V1.3.0): http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cvalue ' * @example myDict.Add(1, cV("True", "b")) ' * @param Variant Wert der geparst wird ' * @param String Flag ('nebd') ' * n: Der Text Null ohne Delemiter wird als Wert Null intepretiert: "NULL" -> Null ' * e: Ein leerer String wird als Null intepretiert, "" -> Null ' * b: Boolean-Text wird als Boolean intepretiert "True" -> True (Boolean) ' * d: Bei Delemited Strings den Delemiter nicht entfernen. ' oder " gelten als Delemiter: "'Hans'" -> Hans ' * @return Variant ' */ Public Function cV(ByVal iValue As Variant, Optional ByVal iFlags As String) As Variant On Error Resume Next: If IsNull(iValue) Then cV = Null: Exit Function If Not VarType(iValue) = 8 Then cV = iValue: Exit Function Static rxDa As Object, rxDs As Object: Dim sm As Object, str As String, flg As String: str = CStr(iValue): flg = UCase(iFlags) If UCase(str) = "NULL" And InStr(flg, "N") Then cV = Null: Exit Function If iValue = Empty And CBool(InStr(flg, "E")) Then cV = Null: Exit Function cV = CByte(str): If cV = str Then Exit Function cV = CInt(str): If cV = str Then Exit Function cV = CLng(str): If cV = str Then Exit Function cV = CDbl(str): If cV = str Then Exit Function cV = CDec(str): If cV = str Then Exit Function If IsDate(str) Then cV = CDate(str): Exit Function Err.clear: If InStr(flg, "B") Then cV = CBool(str): If Err.Number = 0 Then Exit Function If rxDa Is Nothing Then Set rxDa = CreateObject("VBScript.RegExp"): rxDa.pattern = "^#(.*)#$" If rxDa.test(str) Then cV = CDate(rxDa.execute(str)(0).subMatches(0)): Exit Function If InStr(flg, "D") > 0 Then cV = iValue: Exit Function If rxDs Is Nothing Then Set rxDs = CreateObject("VBScript.RegExp"): rxDs.pattern = "^[#""'\[](.*)([""'#\]])$" If rxDs.test(str) Then Set sm = rxDs.execute(str)(0).subMatches: cV = Replace(sm(0), "\" & sm(1), sm(1)): Exit Function cV = iValue End Function