Yaslaw.Info

User Tools

Site Tools

You are here: Yaslaw.Info » VBA » Cast » [VBA] toDoubleGeneric()
Trace: • [VBA] Class Property Let/Get
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
Last revision Both sides next revision
vba:cast:todoublegeneric [01.10.2014 09:36:45]
yaslaw [Anforderungen] 		vba:cast:todoublegeneric [14.11.2016 10:48:26]
yaslaw
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 17: Line 29:
 <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 24: 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 81: 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 cast_toDoubleGeneric.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.txt · Last modified: 17.08.2021 10:22:25 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