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 (V-1.3.0)

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

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