This shows you the differences between two versions of the page.
Both sides previous revision Previous revision Next revision | Previous revision | ||
vba:cast:todoublegeneric [01.10.2014 09:35:58] yaslaw [Enumerator] |
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 36: | Line 44: | ||
End Enum</code> | End Enum</code> | ||
- | ***tngDecimal** Beim Trennzeichen handelt es sich um ein Dezimaltrennzeichen (Standart) | + | ***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 83: | 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> | + | |
- | + | ||
- | + | ||
- | + |