Diese Funktion dient als IN(),wie man sie in vielen anderen Sprachen kennt. Sie kann aber auch ein in_array() abdecken.
found = inSet(search, value1 [,value2... [,value#]]) found = inSet(search, valueList)
Public Function inSet(ByRef iSearch As Variant, ParamArray iItems() As Variant) As Boolean
True oder False. Je nachdem ob der Wert in der Menge ist oder nicht
debug.print inset(2, 1, 2, 3) ' true debug.print inset(2, array(1, 2, 3)) ' true debug.print inset(2, array(1, 2), 3) ' true debug.print inset(3, array(1, 2), 3) ' true debug.print inset("d", "a,b,c,d,e") ' true
Attribute VB_Name = "udf_inSet" '------------------------------------------------------------------------------- '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.3.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") ' 11.09.2014 - ERS - Array-Vergleich hinzugefügt '------------------------------------------------------------------------------- Option Explicit Private Const C_VALUELIST_DELEMITER = "," '/** ' * 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") ' * @example inset(array(1,2), 3, 4, array(1,2)) => true ' * @example inset(array(1,2), 3, 4, array(2, 1)) => false ' * ' * @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), C_VALUELIST_DELEMITER) End If Dim item As Variant: For Each item In iItems inSetArray = compaire(iSearch, item) If inSetArray Then Exit Function Next item End Function '/** ' * Vergleicht 2 Variaben ' * @param Variant ' * @param Variant ' * @return Boolean ' */ Private Function compaire(ByRef iVar1 As Variant, ByRef iVar2 As Variant) As Boolean 'Null Vergleich If IsNull(iVar1) Or IsNull(iVar2) Then compaire = IsNull(iVar1) = IsNull(iVar2) 'in Array vergleichen ElseIf IsArray(iVar1) And IsArray(iVar2) Then ' compaire = compaireArray(iVar1, iVar2) compaire = LBound(iVar1) = LBound(iVar2) And UBound(iVar1) And UBound(iVar2) If compaire Then Dim i As Integer: For i = LBound(iVar1) To UBound(iVar1) compaire = compaire(iVar1(i), iVar2(i)) If Not compaire Then Exit Function Next i End If 'in Array suchen ElseIf IsArray(iVar2) Then compaire = inSetArray(iVar1, iVar2) 'Objekt-Vergleich ElseIf IsObject(iVar1) And IsObject(iVar2) Then compaire = (iVar1 Is iVar2) 'Value-Vergleich ElseIf Not IsObject(iVar1) And Not IsObject(iVar2) And Not IsArray(iVar1) And Not IsArray(iVar2) Then compaire = (iVar1 = cast(VarType(iVar1), iVar2)) End If 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