Yaslaw.Info

User Tools

Site Tools

You are here: Yaslaw.Info » VBA » Cast » [VBA] toDoubleGeneric()
Trace:
vba:cast:todoublegeneric

Differences

This shows you the differences between two versions of the page.

Link to this comparison view

Both sides previous revision Previous revision
Next revision 		Previous revision
vba:cast:todoublegeneric [16.05.2014 10:13:26]
yaslaw [[VBA] toDoubleGeneric()] 		vba:cast:todoublegeneric [17.08.2021 10:22:25] (current)
yaslaw [Enumerator]
Line 1: Line 1:
-====== [VBA] toDoubleGeneric() ====== +<​const>​ 
-{{:vba:cast:​cast_todblgeneric.bas|}}+    version=1.4.0 
 +    vdate=14.011.2016 
 +    fname=cast_todblgeneric.bas 
 +    ns=%NAMESPACE% 
 +    fpath=/vba/cast 
 +</​const>​ 
 +{{keywords>​vba,cast,​double,​number}} 
 +{{description>​Dies ist eine flexible Cast-Funktion um Strings mit verschiedenen Anordnungen von Tausender- und  
 +Dezimaltrennzeichen in ein Double zu wandeln. V-%%version%%}}
  
-Dies ist eine flexible Cast-Funktion um Strings mit verschiedenen Anordnungen von Tausender- und +====== [VBA] toDoubleGeneric() ====== 
 +//Dies ist eine flexible Cast-Funktion um Strings mit verschiedenen Anordnungen von Tausender- und 
 Dezimaltrennzeichen in ein Double zu wandeln. Dezimaltrennzeichen in ein Double zu wandeln.
 +//
 +==Version %%version%% - %%vdate%%==
 +{{%%fname%%|Download %%fname%% (V-%%version%%)}}
  
 Bei mir waren das vor allem Export aus SAP, die im folgenden Format vorlagen: ''​1.234.567,​89-''​ Bei mir waren das vor allem Export aus SAP, die im folgenden Format vorlagen: ''​1.234.567,​89-''​
Line 12: Line 24:
 den [[#​vergleich_mit_anderen_cast-funktionen_fuer_double|Vergleich mit anderen Cast-Funktionen für Double]]. den [[#​vergleich_mit_anderen_cast-funktionen_fuer_double|Vergleich mit anderen Cast-Funktionen für Double]].
  
-===== Anforderungen ==== +
-=== print_r() === +
-[[:​vba:​functions:​print_r:​]] wird nur für die Beispiele gebraucht. Diese Funktion wird im Einsatz nicht gebraucht+
  
 ===== Definition ===== ===== Definition =====
 <code vb>​Public Function toDblGeneric( _ <code vb>​Public Function toDblGeneric( _
         Optional ByVal iNumberV As Variant = Null, _         Optional ByVal iNumberV As Variant = Null, _
-        Optional ByVal iDelemiterHandling As tngDelemiterHandling = tngDecimal, _ +        Optional ByVal iDelemiterHandling As tngDelemiterHandling = tngDecimal _
-        Optional iClearCache As Boolean = False _+
 ) As Double</​code>​ ) As Double</​code>​
  
Line 26: Line 35:
   ***//​iNumberV//​** String oder Nummer, welche gecasted werden soll   ***//​iNumberV//​** String oder Nummer, welche gecasted werden soll
   ***//​iDelemiterHandling//​** tngDelemiterHandling handelt das verhalten beim Speziealfall 1.234   ***//​iDelemiterHandling//​** tngDelemiterHandling handelt das verhalten beim Speziealfall 1.234
-  ***//​iClearCache//​** lag um den Cache neu aufzubauen. Ist mehr in der Programmierphase interessant,​ wenn man an dem Pattern herumspielt 
-  * 
 ==== Enumerator ==== ==== Enumerator ====
 === tngDelemiterHandling === === tngDelemiterHandling ===
Line 37: Line 44:
 End Enum</​code>​ End Enum</​code>​
  
-  ***tngDecimal** Beim Trennzeichen handelt es sich um ein Dezimaltrennzeichen+  ***tngDecimal** Beim Trennzeichen handelt es sich um ein Dezimaltrennzeichen ​(Standard)
   ***tngThousend** Beim Trennzeichen handelt es sich um ein Tausendertrennzeichen   ***tngThousend** Beim Trennzeichen handelt es sich um ein Tausendertrennzeichen
 ==== Rückgabewert ==== ==== Rückgabewert ====
Line 84: Line 91:
 print_r toDblGeneric("​1,​234,​567",​ tngDecimal) print_r toDblGeneric("​1,​234,​567",​ tngDecimal)
 <​Double>​ 1234567 <​Double>​ 1234567
 +
 +'Mit dem E-Faktor
 +print_r toDblGeneric("​2.3 e2")
 +<​Double>​ 230
 </​code>​ </​code>​
  
 ===== Vergleich mit anderen Cast-Funktionen für Double ===== ===== Vergleich mit anderen Cast-Funktionen für Double =====
-{{section>​.:​compairetodoublefunctions#​Vergleichstabelle&​noheader&​firstseconly}}+{{section>​:vba:​compairetodoublefunctions#​Vergleichstabelle&​noheader&​firstseconly}}
  
 ===== Code ===== ===== Code =====
-<code vb toNumber.bas>​ +<source ​'%%fpath%%/%%fname%%' ​vb>
-'------------------------------------------------------------------------------- +
-'​File ​        : toDoubleGeneric +
-' ​              ​Copyright mpl by ERB software +
-' ​              http://​wiki.yaslaw.info/​dokuwiki/​doku.php/​vba/​cast/​toDoubleGeneric +
-'Environment ​ : VBA 2007 + +
-'​Version ​     : 1.2 +
-'​Author ​      : Stefan Erb (ERS) +
-'​History ​     : 15.01.2014 - ERS - Creation +
-' ​            : 11.02.2014 - ERS - Neu wird auch eine Nummer aus einem Text gefiltert. +
-' ​            : 14.02.2014 - ERS - Den Parameter iDelemiterHandling hinzugefügt +
-'​------------------------------------------------------------------------------- +
-Option Explicit +
- +
- +
-'/** +
-' * steuert das verhalten, wenn nicht klar ist, ob das letzte Zeichen ein Dezimaltrennzeichen oder ein Tausendertrennzeichen ist +
-' */ +
-Public Enum tngDelemiterHandling +
-    tngDecimal = 0                  'Der Text 1,234 wird als 1.234 zurückgegeben +
-    tngThousend = 1                 '​Der Text 1,234 wird als 1234 zurückgegeben +
-End Enum +
- +
- +
-'/** +
-' * User-Konstanten. Diese können für weitere Fälle ergänzt werden +
-' */ +
-'Alle möglichen Tausendertrennzeichen als Regulärer Ausdruck +
-Private Const C_TODBLG_THOUSEND_PATTERNS = "​`´',​\." ​  '​alle möglichen Hockommas, Komma und Punkt +
-'Alle möglichen Dezimaltrennzeichen als Regulärer Ausdruck +
-Private Const C_TODBLG_DECIMAL_PATTERNS = ",​\." ​    '​Komma und Punkt +
-'Alle möglichen Vorzeichen als Regulärer AUsdruck +
-Private Const C_TODBLG_SIGN_PATTERNS = "​-\+" ​       'Plus und Minus +
- +
-'/** +
-' * Fixe Konstanten. Diese sollten nicht verandert werden +
-' */ +
-'​Private Const C_TODBLG_PATTERN = "​^([-\+]?​)\s*(\d+(?:​([,​\.])\d{3}([',​\.])\d+|([,​\.])\d{1,​3}()|)[\d',​\.]*)\s*([-\+]?​)$"​ +
-Private Const C_TODBLG_PATTERN = "​^([{$sign}]?​)\s*(\d+(?:​([{$decimal}])\d{3}([{$thousend}])\d+|([{$decimal}])\d{1,​3}()|)[\d{$thousend}]*)\s*([{$sign}]?​)$"​ +
-Private Const C_TODBLG_DECIMAL_PLACEHOLDER = "#​DEC#" ​   '​Temporäres Decimaltrennzeichen,​ dass gesetzt wird. Muss einfach eindeutig sein und darf keines der Tausender- und Dezimatrennzeichen sein +
-Private Const C_TODBLG_ERR_NR = 13                      'Err 13: Type missmatch +
-Private Const C_TODBLG_EXTRACT_NUMBER_PATTERN = "​([{$sign}]?​[\s]*[{$thousend}{$decimal}\d]+[\s]*[{$sign}]?​)"​ +
- +
-'/** +
-' * Cache. Gweisse informationen müssen nur einme gesetzt werden +
-' */ +
-Private strRx       As Object ​  '​Cached RegEx um die erste Nummer aus einem String zu lösen +
-Private dhRx        As Object ​  '​Cached RegEx um das Delemiterhändling im Spezialfall 1.234 zu handhaben +
-Private toDblGRx ​   As Object ​  '​Cached RegEx +
-Private strPattern ​     As String ​  '​Cache the Pattern +
-Private toDblGPattern ​  As String ​  '​Cache the Pattern +
- +
-'/** +
-' * Wandelt einen String in ein Double um, ohne genaue defnitionen +
-' * Mögliche Tausendertrennzeichen:​ ` ´ ' , . keines +
-' * Mögliche Dezimaltrennzeichen:​ , . keines +
-' * Mögliche Vorzeichen vor oder nach der Zahl, mit oder ohne Leerzeichen dazwischen: + - keines +
-' * @param ​ Variant ​    ​Input +
-' * @param ​ tngDelemiterHandling +
-' *                     Es gibt den Sonderfall '​3.456'​. Ist das jetzt 3456 oder 3,456. Mit tngDecima wird daraus 3.456, mit tngThosend 3456 +
-' * @param ​ Boolean ​    Flag um den Cache neu aufzubauen. Ist mehr in der Programmierphase interessant,​ wenn man an dem Pattern herumspielt +
-' * @return Double +
-'*/ +
-Public Function toDblGeneric( _ +
-        Optional ByVal iNumberV As Variant = Null, _ +
-        Optional ByVal iDelemiterHandling As tngDelemiterHandling = tngDecimal, _ +
-        Optional iClearCache As Boolean = False _ +
-) As Double +
-    Dim numberV As Variant: numberV = iNumberV +
-    Dim mc          As Object +
-    Dim parts       As Object +
-On Error GoTo Err_Handler +
- +
-    'Den endgültigen Pattern zusammensetzen +
-    If _ +
-            Nz(toDblGPattern,​ Empty) = Empty _ +
-            Or Nz(strPattern,​ Empty) = Empty _ +
-            Or iClearCache _ +
-    Then +
-        toDblGPattern = replace(C_TODBLG_PATTERN,​ "​{$decimal}",​ C_TODBLG_DECIMAL_PATTERNS) +
-        toDblGPattern = replace(toDblGPattern,​ "​{$thousend}",​ C_TODBLG_THOUSEND_PATTERNS) +
-        toDblGPattern = replace(toDblGPattern,​ "​{$sign}",​ C_TODBLG_SIGN_PATTERNS) +
-        strPattern = replace(C_TODBLG_EXTRACT_NUMBER_PATTERN,​ "​{$decimal}",​ C_TODBLG_DECIMAL_PATTERNS) +
-        strPattern = replace(strPattern,​ "​{$thousend}",​ C_TODBLG_THOUSEND_PATTERNS) +
-        strPattern = replace(strPattern,​ "​{$sign}",​ C_TODBLG_SIGN_PATTERNS) +
-    End If +
-     +
-    'Den Zahlenblock aus dem numberV extrahieren +
-    If strRx Is Nothing Or iClearCache Then +
-        Set strRx = CreateObject("​VBScript.RegExp"​) +
-        strRx.pattern = strPattern +
-    End If +
-    If strRx.test(Nz(numberV)) Then +
-        Set mc = strRx.execute(numberV) +
-        numberV = mc.item(0).SubMatches(0) +
-    End If +
- +
-    'Das RegEx Object initialiseren +
-    If toDblGRx Is Nothing Or iClearCache Then +
-        Set toDblGRx = CreateObject("​VBScript.RegExp"​) +
-        toDblGRx.pattern = toDblGPattern +
-    End If +
- +
-    'Den String umdrehen. IIIf() anstelle von Nz(), damit es auch in Excel funktioniert +
-    Dim numS        As String: ​     numS = StrReverse(IIf(IsNull(numberV) Or numberV = Empty, 0, numberV)) +
-    '​Prüfen,​ ob der string überhaubt greift +
-    If Not toDblGRx.test(numS) Then Err.Raise (C_TODBLG_ERR_NR) +
- +
-    'Den String umdrehen und aufteilen +
-    Set mc = toDblGRx.execute(numS) +
- +
-    'Die einzelnen Teile auslesen +
-    Set parts = mc.item(0).SubMatches +
-    'Parts des Patterns +
-    '0: Vorzeichen danach +
-    '1: Ganze Zahl, ohne Vorzeichen +
-    '2: Dezimaltrennzeichen (Im Fall, dass Tausendertrennzeichen vorhanden sind) +
-    '3: Tausendertrennzeichen +
-    '4: Dezimaltrennzeichen (Im Fall, dass keine Tausendertrennzeichen vorhanden sind) +
-    '5: dummy (Damit im (?:..) kein  Reihenfolgechaos ensteht +
-    '6: Vorzeichen davor +
- +
-    '​Dezimaltrennzeichen ermitteln. Entweder in part 2 oder 4 +
-    Dim decimalSep ​ As String: ​     decimalSep = parts(2) & parts(4) +
- +
-    '​Tausenderzeichen ermitteln +
-    Dim thousendSep As String: ​     thousendSep = parts(3) +
- +
-    '​Vorzeichen ermitteln. Davor der danach. +
-    Dim sign        As String: ​     sign = parts(0) & parts(6) +
- +
-    If dhRx Is Nothing Then +
-        Set dhRx = CreateObject("​VBScript.RegExp"​) +
-        dhRx.pattern = "​^\d{3}\.\d{1,​3}$"​ +
-    End If +
-    '​Prüfen,​ ob es sich um eine Zahl ohne Nachkommastellen handelt +
-    '- Kein Tausendertrennzeiche,​ Dezimaltrennzeichen vorhanden, Delimiterhändling = Tausender, hat nach dem Trennzeichen 3 Stellen, hat vor dem Trennzeichen höchstens 3 Stellen +
-    '- Das Dezimaltrennzeichen ist mit dem Tausnedertrennzeichen identisch, hat nach dem Trennzeichen 3 Stellen, hat vor dem Trennzeichen höchstens 3 Stellen +
-    If _ +
-            (( _ +
-                thousendSep = Empty _ +
-                And decimalSep <> Empty _ +
-                And iDelemiterHandling = tngThousend _ +
-            ) Or ( _ +
-                decimalSep = thousendSep _ +
-            )) _ +
-            And dhRx.test(parts(1)) _ +
-    Then +
-        '​Trennzeichen entfernen +
-        numS = replace(parts(1),​ IIf(thousendSep = Empty, decimalSep, thousendSep),​ vbNullString) +
-    Else +
-        '​Dezmaltrennzeichen markieren +
-        numS = replace(parts(1),​ decimalSep, C_TODBLG_DECIMAL_PLACEHOLDER,​ , 1) +
-        '​Tausendertrennzeichen entfernen +
-        numS = replace(numS,​ thousendSep,​ vbNullString) +
-    End If +
- +
-    '​Markierung des Dezimaltrennzeichens durch einen . ersetzen und das Vorzeichen mitgeben +
-    toDblGeneric = CDbl(sign & StrReverse(replace(numS,​ C_TODBLG_DECIMAL_PLACEHOLDER,​ "​."​))) +
- +
-Exit_Handler:​ +
-    Set parts = Nothing +
-    Set mc = Nothing +
-    Exit Function +
-Err_Handler:​ +
-    Set parts = Nothing +
-    Set mc = Nothing +
-    'Err 13: Type missmatch +
-    Call Err.Raise(C_TODBLG_ERR_NR,​ "​toDblGeneric",​ "Type missmatch"​ & vbCrLf & vbCrLf & "'"​ & iNumberV & "'​ is not a valid Number",​ Err.helpFile,​ Err.helpContext) +
-    Resume +
-End Function +
-</code> +
- +
- +
- +
vba/cast/todoublegeneric.1400228006.txt.gz · Last modified: 16.05.2014 10:13:26 by yaslaw

Page Tools

Except where otherwise noted, content on this wiki is licensed under the following license: GNU Free Documentation License 1.3
GNU Free Documentation License 1.3 Donate Powered by PHP Valid HTML5 Valid CSS Driven by DokuWiki