This shows you the differences between two versions of the page.
Both sides previous revision Previous revision Next revision | Previous revision Last revision Both sides next revision | ||
vba:functions:inset [15.09.2014 11:36:51] yaslaw [Parameters] |
vba:functions:inset [09.10.2014 13:28:10] yaslaw |
||
---|---|---|---|
Line 1: | Line 1: | ||
+ | <const> | ||
+ | version=1.3.0 | ||
+ | vdate=11.09.2014 | ||
+ | fname=udf_inset.bas | ||
+ | ns=%NAMESPACE% | ||
+ | fpath=/vba/functions | ||
+ | </const> | ||
+ | {{keywords>vba,dictionary,cast,create dictionary,function}} | ||
+ | {{description>Diese Funktion erstellt auf verschiedene Arten ein Dictionary. V-%%version%%}} | ||
+ | |||
====== [VBA] inSet() ====== | ====== [VBA] inSet() ====== | ||
+ | ==Version %%version%% %%vdate%%== | ||
Diese Funktion dient als IN(),wie man sie in vielen anderen Sprachen kennt. Sie kann aber auch ein in_array() abdecken. | Diese Funktion dient als IN(),wie man sie in vielen anderen Sprachen kennt. Sie kann aber auch ein in_array() abdecken. | ||
- | {{:vba:functions:udf_inset.bas|download udf_inset.bas}} | + | {{%%fname%%|Download %%fname%% (V-%%version%%)}} |
===== Definition ===== | ===== Definition ===== | ||
Line 24: | Line 35: | ||
===== Code ===== | ===== Code ===== | ||
- | <code vb udf_inset.bas>Attribute VB_Name = "udf_inSet" | + | <source '%%fpath%%/%%fname%%' vb> |
- | '------------------------------------------------------------------------------- | + | |
- | 'File : udf_inSet.bas | + | |
- | ' Copyright mpl by ERB software | + | |
- | ' All rights reserved | + | |
- | ' http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/strtodate | + | |
- | 'Environment : VBA 2007 + | + | |
- | 'Version : 1.2.0 | + | |
- | 'Name : inSet | + | |
- | 'Author : Stefan Erb (ERS) | + | |
- | 'History : 30.04.2014 - ERS - Creation | + | |
- | ' 27.06.2014 - ERS - Die Mögliche hinzugefügt, Arrays zu übergeben | + | |
- | ' 28.08.2014 - ERS - Neu mit Listenstring als Paramter: inset(2, "1,2,3") | + | |
- | '------------------------------------------------------------------------------- | + | |
- | Option Explicit | + | |
- | + | ||
- | '/** | + | |
- | ' * Prüft ein Wert gegen eine Liste von Werten. | + | |
- | ' * Dient als Ersatz des Befehls IN(), den man in vielen anderen Sprachen kennt | + | |
- | ' * Kann auch als in_array dienen | + | |
- | ' * Bei Objekten geht es nur auf dieselbe Instanz. | + | |
- | ' * | + | |
- | ' * found = inSet(search, value1 [,value2... [,value#]]) | + | |
- | ' * found = inSet(search, valueList) | + | |
- | ' * | + | |
- | ' * @example inset(2, 1, 2, 3) => true | + | |
- | ' * @example inset(2, array(1, 2, 3)) => true | + | |
- | ' * @example inset(2, array(1, 2), 3) => true | + | |
- | ' * @example inset(3, 1, array(2, 3)) => true | + | |
- | ' * @example inset(3, "1,2,3,4,5") | + | |
- | ' * | + | |
- | ' * @param Variant Wert der gesucht wird | + | |
- | ' * @paramArray Werte gegen die geprüft wird. Sind die Werte Arrays, werden die Arrays durchsucht | + | |
- | ' * @return Boolean Flag ob der Wert gefunden wird | + | |
- | Public Function inSet(ByRef iSearch As Variant, ParamArray iItems() As Variant) As Boolean | + | |
- | inSet = inSetArray(iSearch, CVar(iItems)) | + | |
- | End Function | + | |
- | + | ||
- | ' * @param Variant Wert der gesucht wird | + | |
- | ' * @param Array Werte gegen die geprüft wird. Sind die Werte Arrays, werden die Arrays durchsucht | + | |
- | ' * @return Boolean Flag ob der Wert gefunden wird | + | |
- | Private Function inSetArray(ByRef iSearch As Variant, ByRef iItems As Variant) As Boolean | + | |
- | If TypeName(iItems(0)) = "String" And UBound(iItems) = 0 Then | + | |
- | iItems = Split(iItems(0), ",") | + | |
- | End If | + | |
- | Dim item As Variant: For Each item In iItems | + | |
- | 'Null Vergleich | + | |
- | If IsNull(iSearch) Or IsNull(item) Then | + | |
- | inSetArray = IsNull(iSearch) = IsNull(item) | + | |
- | 'Array Vergleich | + | |
- | ElseIf IsArray(item) Then | + | |
- | inSetArray = inSetArray(iSearch, item) | + | |
- | 'Objekt-Vergleich | + | |
- | ElseIf IsObject(iSearch) And IsObject(item) Then | + | |
- | inSetArray = (iSearch Is item) | + | |
- | 'Value-Vergleich | + | |
- | ElseIf Not IsObject(iSearch) And Not IsObject(item) Then | + | |
- | Dim search As Variant: search = Nz(iSearch) | + | |
- | Dim find As Variant: find = cast(VarType(search), Nz(item)) | + | |
- | inSetArray = search = find | + | |
- | End If | + | |
- | If inSetArray Then Exit Function | + | |
- | Next item | + | |
- | End Function | + | |
- | + | ||
- | '/** | + | |
- | ' * Wandelt einen String wenn möglich in das angegebene Format um | + | |
- | ' * @param VbVarType | + | |
- | ' * @param Variant | + | |
- | ' * @return Variant | + | |
- | ' */ | + | |
- | Private Function cast(ByVal iType As VbVarType, ByVal iFind As Variant) As Variant | + | |
- | If IsNumeric(iFind) Then | + | |
- | Select Case iType | + | |
- | Case vbInteger: cast = CInt(iFind) | + | |
- | Case vbLong: cast = CLng(iFind) | + | |
- | Case vbDouble: cast = CDbl(iFind) | + | |
- | Case vbDecimal: cast = CDec(iFind) | + | |
- | Case vbByte: cast = CByte(iFind) | + | |
- | Case vbSingle: cast = CSng(iFind) | + | |
- | Case vbCurrency: cast = CCur(iFind) | + | |
- | Case Else: cast = CVar(iFind) | + | |
- | End Select | + | |
- | ElseIf IsDate(iFind) And iType = vbDate Then | + | |
- | cast = CDate(iFind) | + | |
- | Else | + | |
- | cast = iFind | + | |
- | End If | + | |
- | End Function | + | |
- | </code> | + |