Diese Funktion dient als IN(),wie man sie in vielen anderen Sprachen kennt. Sie kann aber auch ein in_array() abdecken.

download udf_inset.bas

found = inSet(search, value1 [,value2... [,value#]])

Public Function inSet(ByRef iSearch As Variant, ParamArray iItems() As Variant) As Boolean

• iSearch Wert der gesucht wird
• ParamArray iItems* Werte gegen die geprüft wird. Sind die Werte Arrays, werden die Arrays durchsucht

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

udf_inset.bas

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.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