Consulting

Results 1 to 17 of 17

Thread: Looping trough varibales names - is that possible

  1. #1
    VBAX Regular
    Joined
    Jul 2017
    Location
    Zurich
    Posts
    77
    Location

    Looping trough varibales names - is that possible

    Hi Folks

    I'm wondering if it's possible to loop trough variable names.

    For example, I'd like to simplify/shorten the following with a for...next loop:

    If IsMissing(strKriterium1) Then
    ' numEinzelResultate = 1
    ' ElseIf IsMissing(strKriterium2) Then
    ' numEinzelResultate = 2
    ' ElseIf IsMissing(strKriterium3) Then
    ' numEinzelResultate = 3
    ' ElseIf IsMissing(strKriterium4) Then
    ' numEinzelResultate = 4
    ' ElseIf IsMissing(strKriterium5) Then
    ' numEinzelResultate = 5
    ' ElseIf IsMissing(strKriterium6) Then
    ' numEinzelResultate = 6
    ' Else
    ' End If

    My try would be something like:

    For i = 1 to 6

    If ismissing(strKriterium & i ) then (this is the problem; it tells me that strKriterium is not definded)
    numEinzelResultate = i (this works obviously)
    .....
    next i

    Any ideas?

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    24,907
    Location
    What are you trying to do, find out whether there is a variable called strKriterium1 (in which case use Option Explicit), or whether it has a value?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,063
    Location
    I'm guessing here that since you're using IsMissing there's a sub or function that and take a varying number of parameters

    https://msdn.microsoft.com/en-us/VBA...6)%26rd%3Dtrue

    Returns a Boolean value indicating whether an optional Variant argument has been passed to a procedure.

    IMHO you'd be better off using the ParamArray keyword

    https://msdn.microsoft.com/en-us/VBA.../sub-statement


    Optional. Used only as the last argument in arglist to indicate that the final argument is an Optionalarray of Variant elements. The ParamArray keyword allows you to provide an arbitrary number of arguments. ParamArray can't be used with ByVal, ByRef, or Optional.


    Option Explicit
    
    Sub drv()
        
        'one required and 4 optiona;
        MsgBox DemoParamArray("Four parameters", 11, 22, 33, 44)
        
        'one required and 2 optional
        MsgBox DemoParamArray("Two parameters", 10, 21, 12)
    End Sub
    
    'could be sub also
    Function DemoParamArray(Always As String, ParamArray Sometimes() As Variant) As Variant
        Dim i As Long
        Dim x As Long
        
        x = 1
        For i = LBound(Sometimes) To UBound(Sometimes)
            x = x * Sometimes(i)
        Next i
        DemoParamArray = Always & " -- " & x
    End Function
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  4. #4
    VBAX Regular
    Joined
    Jul 2017
    Location
    Zurich
    Posts
    77
    Location
    Thanks for your responses,

    It's actually a general question. Please see below...that might explain roughly what i'd like to do:


    Ex1:

    Instead of:

    Dim str1 as string, str2 as string, string3 as string

    I'd like to write sth. like:

    for i = 1 to 3
    Dim str & i as string
    next i


    Ex2:

    Instead of:

    For i = 1 to 3
    If (str & i) = "x" then ....End if
    Next i

  5. #5
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,063
    Location
    You could use an array

    Dim str(1 to 3) as string
    For i = 1 to 3
        If str(I)  = "x" then
             ....
        End if
    Next I
    
    
    'or
    
    Dim str(1 to 3) as string
    For i = LBound(str) to UBound(str)
        If str(I)  = "x" then
             ....
        End if
    Next I
    
    
    
    'or
    
    Dim str(1 to 100) as string
    dim NumEnteries as long
    
    NumEnteries = 3
    
    For i = LBound(str) to NumEnteries
        If str(I)  = "x" then
             ....
        End if
    Next I
    The third (sort of ugly) approach allows you to not be locked in to a possibly too low top
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  6. #6
    VBAX Regular
    Joined
    Jul 2017
    Location
    Zurich
    Posts
    77
    Location
    oh wow that will do the trick...didn't know that'd be possible

  7. #7
    VBAX Regular
    Joined
    Jul 2017
    Location
    Zurich
    Posts
    77
    Location
    oh wow that will do the trick...didn't know that'd be possible

  8. #8
    VBAX Regular
    Joined
    Jul 2017
    Location
    Zurich
    Posts
    77
    Location
    Although I got it kindof, I'm pretty sure I'll get errors when trying to simplify this function – and that's also the reason for my question in the first place...lots of copy & paste


    Public Function PRODUKT0(rngKriterium1 As Variant, Optional strKriterium1 As Variant, _
    Optional rngKriterium2 As Range, Optional strKriterium2 As Variant, Optional rngKriterium3 As Range, Optional strKriterium3 As Variant, _
    Optional rngKriterium4 As Range, Optional strKriterium4 As Variant, Optional rngKriterium5 As Range, Optional strKriterium5 As Variant, _
    Optional rngKriterium6 As Range, Optional strKriterium6 As Variant, Optional rngKriterium7 As Range, Optional strKriterium7 As Variant, _
    Optional rngKriterium8 As Range, Optional strKriterium8 As Variant, Optional rngKriterium9 As Range, Optional strKriterium9 As Variant, _
    Optional rngKriterium10 As Range, Optional strKriterium10 As Variant, Optional rngKriterium11 As Range, Optional strKriterium11 As Variant, _
    Optional rngKriterium12 As Range, Optional strKriterium12 As Variant, Optional rngKriterium13 As Range, Optional strKriterium13 As Variant, _
    Optional rngKriterium14 As Range, Optional strKriterium14 As Variant, Optional rngKriterium15 As Range, Optional strKriterium15 As Variant, _
    Optional rngKriterium16 As Range, Optional strKriterium16 As Variant, Optional rngKriterium17 As Range, Optional strKriterium17 As Variant, _
    Optional rngKriterium18 As Range, Optional strKriterium18 As Variant, Optional rngKriterium19 As Range, Optional strKriterium19 As Variant, _
    Optional rngKriterium20 As Range, Optional strKriterium20 As Variant, Optional rngKriterium21 As Range, Optional strKriterium21 As Variant, _
    Optional rngKriterium22 As Range, Optional strKriterium22 As Variant, Optional rngKriterium23 As Range, Optional strKriterium23 As Variant, _
    Optional rngKriterium24 As Range, Optional strKriterium24 As Variant, Optional rngKriterium25 As Range, Optional strKriterium25 As Variant) As Variant
    
    
    
    
    ' Es können bis zu 25 Kriterien mit dieser Funktion geprüft werden (betrifft nur den Reiter "Produkte", unabhängig von aktueller Produktauswahl)
    ' Die Funktion prüft von welcher Zelle, bzw. Spalte sie aufgerufen wurde, und weiss somit um welches Produkt es sich geht in dieser Spalte
    ' Hiermit können nur Rüster-unabhängige Eigenschaften geprüft werden (dh. das Produkt um das es sich geht in dieser Spalte)
    '
    ' Zulässige Argumente dieser Funktion:
    '
    ' Beispiel 1: =PRODUKT0($A1) Resultat: "x" oder ""
    '
    ' Beispiel 2: =PRODUKT0($A1) ="x" Resultat: "WAHR" oder "FALSCH" ; Gleichwertig mit Beispiel 3
    '
    ' Beispiel 3: =PRODUKT0($A1; "x") Resultat: "WAHR" oder "FALSCH" ; Gleichwertig mit Beispiel 2
    '
    ' Beispiel 4: =WENN(PRODUKT0($A1; "x"); "x"; "?") Resultat: "x" falls "WAHR" ; "?" falls "FALSCH"
    '
    ' Beispiel 5: =WENN(UND(PRODUKT0($A1; "x"; $A2; "x"); "x"; "?") Resultat: gleichwertig mit =WENN(UND(C9= "x"; C10 = "x"); "x"; "?")
    '
    ' Beispiel 6: =PRODUKT0($A1; "x"; $A2; ""; $A3; "x") Resultat: Array (1 bis 3); zB. {"WAHR"/"FALSCH"/"WAHR"}
    '
    ' Beispiel 7: =UND(PRODUKT0($A1; "x"; $A2; ""; $A3; "x")) Resultat: zB. UND({"WAHR"/"FALSCH"/"WAHR"}) ergibt "FALSCH"
    '
    ' Beispiel 8: =ODER(PRODUKT0($A1; "x"; $A2; ""; $A3; "x")) Resultat: zB. ODER({"WAHR"/"FALSCH"/"WAHR"}) ergibt "WAHR"
    
    
    
    
    Application.Volatile 'stellt sicher, dass die Funktion stets neu berechnet wird
    
    
    With wsProdukte
    
    'Zeilennummer der einzelnen Kriterien (Korrektur der Verschiebung damit zB. $A1 dem Kriterium 1 entspricht)
    Dim numKriterium1 As Long, numKriterium2 As Long, numKriterium3 As Long, numKriterium4 As Long, numKriterium5 As Long, _
    numKriterium6 As Long, numKriterium7 As Long, numKriterium8 As Long, numKriterium9 As Long, numKriterium10 As Long, _
    numKriterium11 As Long, numKriterium12 As Long, numKriterium13 As Long, numKriterium14 As Long, numKriterium15 As Long, _
    numKriterium16 As Long, numKriterium17 As Long, numKriterium18 As Long, numKriterium19 As Long, numKriterium20 As Long, _
    numKriterium21 As Long, numKriterium22 As Long, numKriterium23 As Long, numKriterium24 As Long, numKriterium25 As Long
    
    'Variablen zur Ermittlung der Zelladresse von welcher die Funktion aufgerufen wurde
    Dim numZeile As Long, numSpalte As Long, strAdresse As String, numLängeSpaltenBezeichnung As Long
    
    'Resultate in Variable speichern
    Dim blnArgumente() As Boolean
    
    'Anzahl Argumente in Variable speichern
    Dim numEinzelResultate As Long
    
    If Not numProdukteSektion1a > 0 Then
    
    
    'Zeilennummer von Hilfszeile im Reiter "Produkte" in Variable speichern
    numProdukteSektion1a = WorksheetFunction.Match("S1a", .Range("A:A"), 0)
    
    
    End If
    
    'Ermitteln der Zelladresse
    With Application.Caller
    numZeile = .Rows.Count
    numSpalte = .Columns.Count
    strAdresse = .Address 'zB. "$A$1"
    numLängeSpaltenBezeichnung = Len(Mid(strAdresse, 2, InStr(2, strAdresse, "$", vbTextCompare) - 2))
    strAdresse = Mid(strAdresse, 2, numLängeSpaltenBezeichnung) 'zB "A"
    End With
    
    numKriterium1 = rngKriterium1.Row + numProdukteSektion1a + 2
    
    
    '1 Kriterium (1 Argumente, nicht abhängig von Produktwechsel)
    If IsMissing(strKriterium1) Then
    
    PRODUKT0 = .Range(strAdresse & numKriterium1).Value
    Exit Function
    
    '1 Kriterium (2 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium2) Then
    
    ReDim blnArgumente(1 To 1) As Boolean
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    
    '2 Kriterien (4 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium3) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    
    ReDim blnArgumente(1 To 2) As Boolean
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    
    '3 Kriterien (6 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium4) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    
    ReDim blnArgumente(1 To 3) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    
    
    '4 Kriterien (8 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium5) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 4) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    
    '5 Kriterien (10 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium6) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 5) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    
    '6 Kriterien (12 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium7) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 6) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    
    '7 Kriterien (14 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium8) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 7) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    
    '8 Kriterien (16 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium9) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 8) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    
    '9 Kriterien (18 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium10) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    numKriterium9 = rngKriterium9.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 9) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    blnArgumente(9) = .Range(strAdresse & numKriterium9).Value = strKriterium9
    
    '10 Kriterien (20 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium11) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    numKriterium9 = rngKriterium9.Row + numProdukteSektion1a + 2
    numKriterium10 = rngKriterium10.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 10) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    blnArgumente(9) = .Range(strAdresse & numKriterium9).Value = strKriterium9
    blnArgumente(10) = .Range(strAdresse & numKriterium10).Value = strKriterium10
    
    '11 Kriterien (22 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium12) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    numKriterium9 = rngKriterium9.Row + numProdukteSektion1a + 2
    numKriterium10 = rngKriterium10.Row + numProdukteSektion1a + 2
    numKriterium11 = rngKriterium11.Row + numProdukteSektion1a + 2
    
    ReDim blnArgumente(1 To 11) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    blnArgumente(9) = .Range(strAdresse & numKriterium9).Value = strKriterium9
    blnArgumente(10) = .Range(strAdresse & numKriterium10).Value = strKriterium10
    blnArgumente(11) = .Range(strAdresse & numKriterium11).Value = strKriterium11
    
    '12 Kriterien (24 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium13) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    numKriterium9 = rngKriterium9.Row + numProdukteSektion1a + 2
    numKriterium10 = rngKriterium10.Row + numProdukteSektion1a + 2
    numKriterium11 = rngKriterium11.Row + numProdukteSektion1a + 2
    numKriterium12 = rngKriterium12.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 12) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    blnArgumente(9) = .Range(strAdresse & numKriterium9).Value = strKriterium9
    blnArgumente(10) = .Range(strAdresse & numKriterium10).Value = strKriterium10
    blnArgumente(11) = .Range(strAdresse & numKriterium11).Value = strKriterium11
    blnArgumente(12) = .Range(strAdresse & numKriterium12).Value = strKriterium12
    
    '13 Kriterien (26 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium14) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    numKriterium9 = rngKriterium9.Row + numProdukteSektion1a + 2
    numKriterium10 = rngKriterium10.Row + numProdukteSektion1a + 2
    numKriterium11 = rngKriterium11.Row + numProdukteSektion1a + 2
    numKriterium12 = rngKriterium12.Row + numProdukteSektion1a + 2
    numKriterium13 = rngKriterium13.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 13) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    blnArgumente(9) = .Range(strAdresse & numKriterium9).Value = strKriterium9
    blnArgumente(10) = .Range(strAdresse & numKriterium10).Value = strKriterium10
    blnArgumente(11) = .Range(strAdresse & numKriterium11).Value = strKriterium11
    blnArgumente(12) = .Range(strAdresse & numKriterium12).Value = strKriterium12
    blnArgumente(13) = .Range(strAdresse & numKriterium13).Value = strKriterium13
    
    
    '14 Kriterien (28 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium15) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    numKriterium9 = rngKriterium9.Row + numProdukteSektion1a + 2
    numKriterium10 = rngKriterium10.Row + numProdukteSektion1a + 2
    numKriterium11 = rngKriterium11.Row + numProdukteSektion1a + 2
    numKriterium12 = rngKriterium12.Row + numProdukteSektion1a + 2
    numKriterium13 = rngKriterium13.Row + numProdukteSektion1a + 2
    numKriterium14 = rngKriterium14.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 14) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    blnArgumente(9) = .Range(strAdresse & numKriterium9).Value = strKriterium9
    blnArgumente(10) = .Range(strAdresse & numKriterium10).Value = strKriterium10
    blnArgumente(11) = .Range(strAdresse & numKriterium11).Value = strKriterium11
    blnArgumente(12) = .Range(strAdresse & numKriterium12).Value = strKriterium12
    blnArgumente(13) = .Range(strAdresse & numKriterium13).Value = strKriterium13
    blnArgumente(14) = .Range(strAdresse & numKriterium14).Value = strKriterium14
    
    '15 Kriterien (30 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium16) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    numKriterium9 = rngKriterium9.Row + numProdukteSektion1a + 2
    numKriterium10 = rngKriterium10.Row + numProdukteSektion1a + 2
    numKriterium11 = rngKriterium11.Row + numProdukteSektion1a + 2
    numKriterium12 = rngKriterium12.Row + numProdukteSektion1a + 2
    numKriterium13 = rngKriterium13.Row + numProdukteSektion1a + 2
    numKriterium14 = rngKriterium14.Row + numProdukteSektion1a + 2
    numKriterium15 = rngKriterium15.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 15) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    blnArgumente(9) = .Range(strAdresse & numKriterium9).Value = strKriterium9
    blnArgumente(10) = .Range(strAdresse & numKriterium10).Value = strKriterium10
    blnArgumente(11) = .Range(strAdresse & numKriterium11).Value = strKriterium11
    blnArgumente(12) = .Range(strAdresse & numKriterium12).Value = strKriterium12
    blnArgumente(13) = .Range(strAdresse & numKriterium13).Value = strKriterium13
    blnArgumente(14) = .Range(strAdresse & numKriterium14).Value = strKriterium14
    blnArgumente(15) = .Range(strAdresse & numKriterium15).Value = strKriterium15
    
    '16 Kriterien (32 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium17) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    numKriterium9 = rngKriterium9.Row + numProdukteSektion1a + 2
    numKriterium10 = rngKriterium10.Row + numProdukteSektion1a + 2
    numKriterium11 = rngKriterium11.Row + numProdukteSektion1a + 2
    numKriterium12 = rngKriterium12.Row + numProdukteSektion1a + 2
    numKriterium13 = rngKriterium13.Row + numProdukteSektion1a + 2
    numKriterium14 = rngKriterium14.Row + numProdukteSektion1a + 2
    numKriterium15 = rngKriterium15.Row + numProdukteSektion1a + 2
    numKriterium16 = rngKriterium16.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 16) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    blnArgumente(9) = .Range(strAdresse & numKriterium9).Value = strKriterium9
    blnArgumente(10) = .Range(strAdresse & numKriterium10).Value = strKriterium10
    blnArgumente(11) = .Range(strAdresse & numKriterium11).Value = strKriterium11
    blnArgumente(12) = .Range(strAdresse & numKriterium12).Value = strKriterium12
    blnArgumente(13) = .Range(strAdresse & numKriterium13).Value = strKriterium13
    blnArgumente(14) = .Range(strAdresse & numKriterium14).Value = strKriterium14
    blnArgumente(15) = .Range(strAdresse & numKriterium15).Value = strKriterium15
    blnArgumente(16) = .Range(strAdresse & numKriterium16).Value = strKriterium16
    
    '17 Kriterien (34 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium18) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    numKriterium9 = rngKriterium9.Row + numProdukteSektion1a + 2
    numKriterium10 = rngKriterium10.Row + numProdukteSektion1a + 2
    numKriterium11 = rngKriterium11.Row + numProdukteSektion1a + 2
    numKriterium12 = rngKriterium12.Row + numProdukteSektion1a + 2
    numKriterium13 = rngKriterium13.Row + numProdukteSektion1a + 2
    numKriterium14 = rngKriterium14.Row + numProdukteSektion1a + 2
    numKriterium15 = rngKriterium15.Row + numProdukteSektion1a + 2
    numKriterium16 = rngKriterium16.Row + numProdukteSektion1a + 2
    numKriterium17 = rngKriterium17.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 17) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    blnArgumente(9) = .Range(strAdresse & numKriterium9).Value = strKriterium9
    blnArgumente(10) = .Range(strAdresse & numKriterium10).Value = strKriterium10
    blnArgumente(11) = .Range(strAdresse & numKriterium11).Value = strKriterium11
    blnArgumente(12) = .Range(strAdresse & numKriterium12).Value = strKriterium12
    blnArgumente(13) = .Range(strAdresse & numKriterium13).Value = strKriterium13
    blnArgumente(14) = .Range(strAdresse & numKriterium14).Value = strKriterium14
    blnArgumente(15) = .Range(strAdresse & numKriterium15).Value = strKriterium15
    blnArgumente(16) = .Range(strAdresse & numKriterium16).Value = strKriterium16
    blnArgumente(17) = .Range(strAdresse & numKriterium17).Value = strKriterium17
    
    '18 Kriterien (36 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium19) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    numKriterium9 = rngKriterium9.Row + numProdukteSektion1a + 2
    numKriterium10 = rngKriterium10.Row + numProdukteSektion1a + 2
    numKriterium11 = rngKriterium11.Row + numProdukteSektion1a + 2
    numKriterium12 = rngKriterium12.Row + numProdukteSektion1a + 2
    numKriterium13 = rngKriterium13.Row + numProdukteSektion1a + 2
    numKriterium14 = rngKriterium14.Row + numProdukteSektion1a + 2
    numKriterium15 = rngKriterium15.Row + numProdukteSektion1a + 2
    numKriterium16 = rngKriterium16.Row + numProdukteSektion1a + 2
    numKriterium17 = rngKriterium17.Row + numProdukteSektion1a + 2
    numKriterium18 = rngKriterium18.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 18) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    blnArgumente(9) = .Range(strAdresse & numKriterium9).Value = strKriterium9
    blnArgumente(10) = .Range(strAdresse & numKriterium10).Value = strKriterium10
    blnArgumente(11) = .Range(strAdresse & numKriterium11).Value = strKriterium11
    blnArgumente(12) = .Range(strAdresse & numKriterium12).Value = strKriterium12
    blnArgumente(13) = .Range(strAdresse & numKriterium13).Value = strKriterium13
    blnArgumente(14) = .Range(strAdresse & numKriterium14).Value = strKriterium14
    blnArgumente(15) = .Range(strAdresse & numKriterium15).Value = strKriterium15
    blnArgumente(16) = .Range(strAdresse & numKriterium16).Value = strKriterium16
    blnArgumente(17) = .Range(strAdresse & numKriterium17).Value = strKriterium17
    blnArgumente(18) = .Range(strAdresse & numKriterium18).Value = strKriterium18
    
    '19 Kriterien (38 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium20) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    numKriterium9 = rngKriterium9.Row + numProdukteSektion1a + 2
    numKriterium10 = rngKriterium10.Row + numProdukteSektion1a + 2
    numKriterium11 = rngKriterium11.Row + numProdukteSektion1a + 2
    numKriterium12 = rngKriterium12.Row + numProdukteSektion1a + 2
    numKriterium13 = rngKriterium13.Row + numProdukteSektion1a + 2
    numKriterium14 = rngKriterium14.Row + numProdukteSektion1a + 2
    numKriterium15 = rngKriterium15.Row + numProdukteSektion1a + 2
    numKriterium16 = rngKriterium16.Row + numProdukteSektion1a + 2
    numKriterium17 = rngKriterium17.Row + numProdukteSektion1a + 2
    numKriterium18 = rngKriterium18.Row + numProdukteSektion1a + 2
    numKriterium19 = rngKriterium19.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 19) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    blnArgumente(9) = .Range(strAdresse & numKriterium9).Value = strKriterium9
    blnArgumente(10) = .Range(strAdresse & numKriterium10).Value = strKriterium10
    blnArgumente(11) = .Range(strAdresse & numKriterium11).Value = strKriterium11
    blnArgumente(12) = .Range(strAdresse & numKriterium12).Value = strKriterium12
    blnArgumente(13) = .Range(strAdresse & numKriterium13).Value = strKriterium13
    blnArgumente(14) = .Range(strAdresse & numKriterium14).Value = strKriterium14
    blnArgumente(15) = .Range(strAdresse & numKriterium15).Value = strKriterium15
    blnArgumente(16) = .Range(strAdresse & numKriterium16).Value = strKriterium16
    blnArgumente(17) = .Range(strAdresse & numKriterium17).Value = strKriterium17
    blnArgumente(18) = .Range(strAdresse & numKriterium18).Value = strKriterium18
    blnArgumente(19) = .Range(strAdresse & numKriterium19).Value = strKriterium19
    
    '20 Kriterien (40 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium21) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    numKriterium9 = rngKriterium9.Row + numProdukteSektion1a + 2
    numKriterium10 = rngKriterium10.Row + numProdukteSektion1a + 2
    numKriterium11 = rngKriterium11.Row + numProdukteSektion1a + 2
    numKriterium12 = rngKriterium12.Row + numProdukteSektion1a + 2
    numKriterium13 = rngKriterium13.Row + numProdukteSektion1a + 2
    numKriterium14 = rngKriterium14.Row + numProdukteSektion1a + 2
    numKriterium15 = rngKriterium15.Row + numProdukteSektion1a + 2
    numKriterium16 = rngKriterium16.Row + numProdukteSektion1a + 2
    numKriterium17 = rngKriterium17.Row + numProdukteSektion1a + 2
    numKriterium18 = rngKriterium18.Row + numProdukteSektion1a + 2
    numKriterium19 = rngKriterium19.Row + numProdukteSektion1a + 2
    numKriterium20 = rngKriterium20.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 20) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    blnArgumente(9) = .Range(strAdresse & numKriterium9).Value = strKriterium9
    blnArgumente(10) = .Range(strAdresse & numKriterium10).Value = strKriterium10
    blnArgumente(11) = .Range(strAdresse & numKriterium11).Value = strKriterium11
    blnArgumente(12) = .Range(strAdresse & numKriterium12).Value = strKriterium12
    blnArgumente(13) = .Range(strAdresse & numKriterium13).Value = strKriterium13
    blnArgumente(14) = .Range(strAdresse & numKriterium14).Value = strKriterium14
    blnArgumente(15) = .Range(strAdresse & numKriterium15).Value = strKriterium15
    blnArgumente(16) = .Range(strAdresse & numKriterium16).Value = strKriterium16
    blnArgumente(17) = .Range(strAdresse & numKriterium17).Value = strKriterium17
    blnArgumente(18) = .Range(strAdresse & numKriterium18).Value = strKriterium18
    blnArgumente(19) = .Range(strAdresse & numKriterium19).Value = strKriterium19
    blnArgumente(20) = .Range(strAdresse & numKriterium20).Value = strKriterium20
    
    '21 Kriterien (42 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium22) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    numKriterium9 = rngKriterium9.Row + numProdukteSektion1a + 2
    numKriterium10 = rngKriterium10.Row + numProdukteSektion1a + 2
    numKriterium11 = rngKriterium11.Row + numProdukteSektion1a + 2
    numKriterium12 = rngKriterium12.Row + numProdukteSektion1a + 2
    numKriterium13 = rngKriterium13.Row + numProdukteSektion1a + 2
    numKriterium14 = rngKriterium14.Row + numProdukteSektion1a + 2
    numKriterium15 = rngKriterium15.Row + numProdukteSektion1a + 2
    numKriterium16 = rngKriterium16.Row + numProdukteSektion1a + 2
    numKriterium17 = rngKriterium17.Row + numProdukteSektion1a + 2
    numKriterium18 = rngKriterium18.Row + numProdukteSektion1a + 2
    numKriterium19 = rngKriterium19.Row + numProdukteSektion1a + 2
    numKriterium20 = rngKriterium20.Row + numProdukteSektion1a + 2
    numKriterium21 = rngKriterium21.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 21) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    blnArgumente(9) = .Range(strAdresse & numKriterium9).Value = strKriterium9
    blnArgumente(10) = .Range(strAdresse & numKriterium10).Value = strKriterium10
    blnArgumente(11) = .Range(strAdresse & numKriterium11).Value = strKriterium11
    blnArgumente(12) = .Range(strAdresse & numKriterium12).Value = strKriterium12
    blnArgumente(13) = .Range(strAdresse & numKriterium13).Value = strKriterium13
    blnArgumente(14) = .Range(strAdresse & numKriterium14).Value = strKriterium14
    blnArgumente(15) = .Range(strAdresse & numKriterium15).Value = strKriterium15
    blnArgumente(16) = .Range(strAdresse & numKriterium16).Value = strKriterium16
    blnArgumente(17) = .Range(strAdresse & numKriterium17).Value = strKriterium17
    blnArgumente(18) = .Range(strAdresse & numKriterium18).Value = strKriterium18
    blnArgumente(19) = .Range(strAdresse & numKriterium19).Value = strKriterium19
    blnArgumente(20) = .Range(strAdresse & numKriterium20).Value = strKriterium20
    blnArgumente(21) = .Range(strAdresse & numKriterium21).Value = strKriterium21
    
    '22 Kriterien (44 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium23) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    numKriterium9 = rngKriterium9.Row + numProdukteSektion1a + 2
    numKriterium10 = rngKriterium10.Row + numProdukteSektion1a + 2
    numKriterium11 = rngKriterium11.Row + numProdukteSektion1a + 2
    numKriterium12 = rngKriterium12.Row + numProdukteSektion1a + 2
    numKriterium13 = rngKriterium13.Row + numProdukteSektion1a + 2
    numKriterium14 = rngKriterium14.Row + numProdukteSektion1a + 2
    numKriterium15 = rngKriterium15.Row + numProdukteSektion1a + 2
    numKriterium16 = rngKriterium16.Row + numProdukteSektion1a + 2
    numKriterium17 = rngKriterium17.Row + numProdukteSektion1a + 2
    numKriterium18 = rngKriterium18.Row + numProdukteSektion1a + 2
    numKriterium19 = rngKriterium19.Row + numProdukteSektion1a + 2
    numKriterium20 = rngKriterium20.Row + numProdukteSektion1a + 2
    numKriterium21 = rngKriterium21.Row + numProdukteSektion1a + 2
    numKriterium22 = rngKriterium22.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 22) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    blnArgumente(9) = .Range(strAdresse & numKriterium9).Value = strKriterium9
    blnArgumente(10) = .Range(strAdresse & numKriterium10).Value = strKriterium10
    blnArgumente(11) = .Range(strAdresse & numKriterium11).Value = strKriterium11
    blnArgumente(12) = .Range(strAdresse & numKriterium12).Value = strKriterium12
    blnArgumente(13) = .Range(strAdresse & numKriterium13).Value = strKriterium13
    blnArgumente(14) = .Range(strAdresse & numKriterium14).Value = strKriterium14
    blnArgumente(15) = .Range(strAdresse & numKriterium15).Value = strKriterium15
    blnArgumente(16) = .Range(strAdresse & numKriterium16).Value = strKriterium16
    blnArgumente(17) = .Range(strAdresse & numKriterium17).Value = strKriterium17
    blnArgumente(18) = .Range(strAdresse & numKriterium18).Value = strKriterium18
    blnArgumente(19) = .Range(strAdresse & numKriterium19).Value = strKriterium19
    blnArgumente(20) = .Range(strAdresse & numKriterium20).Value = strKriterium20
    blnArgumente(21) = .Range(strAdresse & numKriterium21).Value = strKriterium21
    blnArgumente(22) = .Range(strAdresse & numKriterium22).Value = strKriterium22
    
    '23 Kriterien (46 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium24) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    numKriterium9 = rngKriterium9.Row + numProdukteSektion1a + 2
    numKriterium10 = rngKriterium10.Row + numProdukteSektion1a + 2
    numKriterium11 = rngKriterium11.Row + numProdukteSektion1a + 2
    numKriterium12 = rngKriterium12.Row + numProdukteSektion1a + 2
    numKriterium13 = rngKriterium13.Row + numProdukteSektion1a + 2
    numKriterium14 = rngKriterium14.Row + numProdukteSektion1a + 2
    numKriterium15 = rngKriterium15.Row + numProdukteSektion1a + 2
    numKriterium16 = rngKriterium16.Row + numProdukteSektion1a + 2
    numKriterium17 = rngKriterium17.Row + numProdukteSektion1a + 2
    numKriterium18 = rngKriterium18.Row + numProdukteSektion1a + 2
    numKriterium19 = rngKriterium19.Row + numProdukteSektion1a + 2
    numKriterium20 = rngKriterium20.Row + numProdukteSektion1a + 2
    numKriterium21 = rngKriterium21.Row + numProdukteSektion1a + 2
    numKriterium22 = rngKriterium22.Row + numProdukteSektion1a + 2
    numKriterium23 = rngKriterium23.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 23) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    blnArgumente(9) = .Range(strAdresse & numKriterium9).Value = strKriterium9
    blnArgumente(10) = .Range(strAdresse & numKriterium10).Value = strKriterium10
    blnArgumente(11) = .Range(strAdresse & numKriterium11).Value = strKriterium11
    blnArgumente(12) = .Range(strAdresse & numKriterium12).Value = strKriterium12
    blnArgumente(13) = .Range(strAdresse & numKriterium13).Value = strKriterium13
    blnArgumente(14) = .Range(strAdresse & numKriterium14).Value = strKriterium14
    blnArgumente(15) = .Range(strAdresse & numKriterium15).Value = strKriterium15
    blnArgumente(16) = .Range(strAdresse & numKriterium16).Value = strKriterium16
    blnArgumente(17) = .Range(strAdresse & numKriterium17).Value = strKriterium17
    blnArgumente(18) = .Range(strAdresse & numKriterium18).Value = strKriterium18
    blnArgumente(19) = .Range(strAdresse & numKriterium19).Value = strKriterium19
    blnArgumente(20) = .Range(strAdresse & numKriterium20).Value = strKriterium20
    blnArgumente(21) = .Range(strAdresse & numKriterium21).Value = strKriterium21
    blnArgumente(22) = .Range(strAdresse & numKriterium22).Value = strKriterium22
    blnArgumente(23) = .Range(strAdresse & numKriterium23).Value = strKriterium23
    
    '24 Kriterien (48 Argumente, nicht abhängig von Produktwechsel)
    ElseIf IsMissing(strKriterium25) Then
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    numKriterium9 = rngKriterium9.Row + numProdukteSektion1a + 2
    numKriterium10 = rngKriterium10.Row + numProdukteSektion1a + 2
    numKriterium11 = rngKriterium11.Row + numProdukteSektion1a + 2
    numKriterium12 = rngKriterium12.Row + numProdukteSektion1a + 2
    numKriterium13 = rngKriterium13.Row + numProdukteSektion1a + 2
    numKriterium14 = rngKriterium14.Row + numProdukteSektion1a + 2
    numKriterium15 = rngKriterium15.Row + numProdukteSektion1a + 2
    numKriterium16 = rngKriterium16.Row + numProdukteSektion1a + 2
    numKriterium17 = rngKriterium17.Row + numProdukteSektion1a + 2
    numKriterium18 = rngKriterium18.Row + numProdukteSektion1a + 2
    numKriterium19 = rngKriterium19.Row + numProdukteSektion1a + 2
    numKriterium20 = rngKriterium20.Row + numProdukteSektion1a + 2
    numKriterium21 = rngKriterium21.Row + numProdukteSektion1a + 2
    numKriterium22 = rngKriterium22.Row + numProdukteSektion1a + 2
    numKriterium23 = rngKriterium23.Row + numProdukteSektion1a + 2
    numKriterium24 = rngKriterium24.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 24) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    blnArgumente(9) = .Range(strAdresse & numKriterium9).Value = strKriterium9
    blnArgumente(10) = .Range(strAdresse & numKriterium10).Value = strKriterium10
    blnArgumente(11) = .Range(strAdresse & numKriterium11).Value = strKriterium11
    blnArgumente(12) = .Range(strAdresse & numKriterium12).Value = strKriterium12
    blnArgumente(13) = .Range(strAdresse & numKriterium13).Value = strKriterium13
    blnArgumente(14) = .Range(strAdresse & numKriterium14).Value = strKriterium14
    blnArgumente(15) = .Range(strAdresse & numKriterium15).Value = strKriterium15
    blnArgumente(16) = .Range(strAdresse & numKriterium16).Value = strKriterium16
    blnArgumente(17) = .Range(strAdresse & numKriterium17).Value = strKriterium17
    blnArgumente(18) = .Range(strAdresse & numKriterium18).Value = strKriterium18
    blnArgumente(19) = .Range(strAdresse & numKriterium19).Value = strKriterium19
    blnArgumente(20) = .Range(strAdresse & numKriterium20).Value = strKriterium20
    blnArgumente(21) = .Range(strAdresse & numKriterium21).Value = strKriterium21
    blnArgumente(22) = .Range(strAdresse & numKriterium22).Value = strKriterium22
    blnArgumente(23) = .Range(strAdresse & numKriterium23).Value = strKriterium23
    blnArgumente(24) = .Range(strAdresse & numKriterium24).Value = strKriterium24
    
    '25 Kriterien (50 Argumente, nicht abhängig von Produktwechsel)
    Else
    
    numKriterium2 = rngKriterium2.Row + numProdukteSektion1a + 2
    numKriterium3 = rngKriterium3.Row + numProdukteSektion1a + 2
    numKriterium4 = rngKriterium4.Row + numProdukteSektion1a + 2
    numKriterium5 = rngKriterium5.Row + numProdukteSektion1a + 2
    numKriterium6 = rngKriterium6.Row + numProdukteSektion1a + 2
    numKriterium7 = rngKriterium7.Row + numProdukteSektion1a + 2
    numKriterium8 = rngKriterium8.Row + numProdukteSektion1a + 2
    numKriterium9 = rngKriterium9.Row + numProdukteSektion1a + 2
    numKriterium10 = rngKriterium10.Row + numProdukteSektion1a + 2
    numKriterium11 = rngKriterium11.Row + numProdukteSektion1a + 2
    numKriterium12 = rngKriterium12.Row + numProdukteSektion1a + 2
    numKriterium13 = rngKriterium13.Row + numProdukteSektion1a + 2
    numKriterium14 = rngKriterium14.Row + numProdukteSektion1a + 2
    numKriterium15 = rngKriterium15.Row + numProdukteSektion1a + 2
    numKriterium16 = rngKriterium16.Row + numProdukteSektion1a + 2
    numKriterium17 = rngKriterium17.Row + numProdukteSektion1a + 2
    numKriterium18 = rngKriterium18.Row + numProdukteSektion1a + 2
    numKriterium19 = rngKriterium19.Row + numProdukteSektion1a + 2
    numKriterium20 = rngKriterium20.Row + numProdukteSektion1a + 2
    numKriterium21 = rngKriterium21.Row + numProdukteSektion1a + 2
    numKriterium22 = rngKriterium22.Row + numProdukteSektion1a + 2
    numKriterium23 = rngKriterium23.Row + numProdukteSektion1a + 2
    numKriterium24 = rngKriterium24.Row + numProdukteSektion1a + 2
    numKriterium25 = rngKriterium25.Row + numProdukteSektion1a + 2
    
    
    ReDim blnArgumente(1 To 25) As Boolean
    
    
    blnArgumente(1) = .Range(strAdresse & numKriterium1).Value = strKriterium1
    blnArgumente(2) = .Range(strAdresse & numKriterium2).Value = strKriterium2
    blnArgumente(3) = .Range(strAdresse & numKriterium3).Value = strKriterium3
    blnArgumente(4) = .Range(strAdresse & numKriterium4).Value = strKriterium4
    blnArgumente(5) = .Range(strAdresse & numKriterium5).Value = strKriterium5
    blnArgumente(6) = .Range(strAdresse & numKriterium6).Value = strKriterium6
    blnArgumente(7) = .Range(strAdresse & numKriterium7).Value = strKriterium7
    blnArgumente(8) = .Range(strAdresse & numKriterium8).Value = strKriterium8
    blnArgumente(9) = .Range(strAdresse & numKriterium9).Value = strKriterium9
    blnArgumente(10) = .Range(strAdresse & numKriterium10).Value = strKriterium10
    blnArgumente(11) = .Range(strAdresse & numKriterium11).Value = strKriterium11
    blnArgumente(12) = .Range(strAdresse & numKriterium12).Value = strKriterium12
    blnArgumente(13) = .Range(strAdresse & numKriterium13).Value = strKriterium13
    blnArgumente(14) = .Range(strAdresse & numKriterium14).Value = strKriterium14
    blnArgumente(15) = .Range(strAdresse & numKriterium15).Value = strKriterium15
    blnArgumente(16) = .Range(strAdresse & numKriterium16).Value = strKriterium16
    blnArgumente(17) = .Range(strAdresse & numKriterium17).Value = strKriterium17
    blnArgumente(18) = .Range(strAdresse & numKriterium18).Value = strKriterium18
    blnArgumente(19) = .Range(strAdresse & numKriterium19).Value = strKriterium19
    blnArgumente(20) = .Range(strAdresse & numKriterium20).Value = strKriterium20
    blnArgumente(21) = .Range(strAdresse & numKriterium21).Value = strKriterium21
    blnArgumente(22) = .Range(strAdresse & numKriterium22).Value = strKriterium22
    blnArgumente(23) = .Range(strAdresse & numKriterium23).Value = strKriterium23
    blnArgumente(24) = .Range(strAdresse & numKriterium24).Value = strKriterium24
    blnArgumente(25) = .Range(strAdresse & numKriterium25).Value = strKriterium25
    
    End If
    
    PRODUKT0 = blnArgumente
    
    
    End With
    
    
    End Function
    Last edited by Paul_Hossler; 06-14-2018 at 04:58 PM.

  9. #9
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,063
    Location
    1. I added CODE tags around the REALLY long macro

    2. If it were me, I'd use ParamArray like in Post #3 and work with how many were passed instead of all the duplicate code and ReDim-ing

    BUT … since it's not clear to me what you're trying to do, this is only any example


     
    Option Explicit
    
    Public Function PRODUKT0(rngKriterium1 As Range, ParamArray strKriterium()) As Variant
        Dim i As Long
        Dim s As String
        Dim rRows() As String
        
        If UBound(strKriterium) > -1 Then ReDim rRows(LBound(strKriterium) To UBound(strKriterium))
        
        Select Case UBound(strKriterium)
            Case -1
                'MsgBox "Nothing passed"
                PRODUKT0 = ""
            
            Case 0
                'MsgBox "1 parameter passed"
                For i = LBound(strKriterium) To UBound(strKriterium)
                    rRows(i) = strKriterium(i)
                    s = s & strKriterium(i)
                Next i
                PRODUKT0 = s
            
            Case 1
                'MsgBox "2 parameters passed"
                For i = LBound(strKriterium) To UBound(strKriterium)
                    rRows(i) = strKriterium(i)
                    s = s & strKriterium(i)
                Next i
                PRODUKT0 = s
                    
            'Case ..... rest
        End Select
        
    End Function
    
    Sub drv()
        
        MsgBox PRODUKT0(ActiveSheet.Range("A1:Z26"))
        MsgBox PRODUKT0(ActiveSheet.Range("A1:Z26"), "AAAAAAAAAAAAA")
        MsgBox PRODUKT0(ActiveSheet.Range("A1:Z26"), "BBBBBBBBBBBBBBB", "CCCCCCCCCCCCCCCCCCCC")
    End Sub
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  10. #10
    VBAX Regular
    Joined
    Jul 2017
    Location
    Zurich
    Posts
    77
    Location
    Thanks once more

    ...i'll try the parameter array, but haven't got a clue yet..)

  11. #11
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,063
    Location
    If you tell us what you're trying to do (and not how you think you want to do it) we might be able to offer better suggestions

    An example of a small workbook might help also

    All I can figure out from the function declaration is that you're passing up to 25 pairs of ranges and strings

    Public Function PRODUKT0(rngKriterium1 As Variant, Optional strKriterium1 As Variant, _ Optional rngKriterium2 As Range, Optional strKriterium2 As Variant, Optional rngKriterium3 As Range, Optional strKriterium3 As Variant, _ Optional rngKriterium4 As Range, Optional strKriterium4 As Variant, Optional rngKriterium5 As Range, Optional strKriterium5 As Variant, _ Optional rngKriterium6 As Range, Optional strKriterium6 As Variant, Optional rngKriterium7 As Range, Optional strKriterium7 As Variant, _ Optional rngKriterium8 As Range, Optional strKriterium8 As Variant, Optional rngKriterium9 As Range, Optional strKriterium9 As Variant, _ Optional rngKriterium10 As Range, Optional strKriterium10 As Variant, Optional rngKriterium11 As Range, Optional strKriterium11 As Variant, _ Optional rngKriterium12 As Range, Optional strKriterium12 As Variant, Optional rngKriterium13 As Range, Optional strKriterium13 As Variant, _ Optional rngKriterium14 As Range, Optional strKriterium14 As Variant, Optional rngKriterium15 As Range, Optional strKriterium15 As Variant, _ Optional rngKriterium16 As Range, Optional strKriterium16 As Variant, Optional rngKriterium17 As Range, Optional strKriterium17 As Variant, _ Optional rngKriterium18 As Range, Optional strKriterium18 As Variant, Optional rngKriterium19 As Range, Optional strKriterium19 As Variant, _ Optional rngKriterium20 As Range, Optional strKriterium20 As Variant, Optional rngKriterium21 As Range, Optional strKriterium21 As Variant, _ Optional rngKriterium22 As Range, Optional strKriterium22 As Variant, Optional rngKriterium23 As Range, Optional strKriterium23 As Variant, _ Optional rngKriterium24 As Range, Optional strKriterium24 As Variant, Optional rngKriterium25 As Range, Optional strKriterium25 As Variant) As Variant
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  12. #12
    VBAX Regular
    Joined
    Jul 2017
    Location
    Zurich
    Posts
    77
    Location
    Hey Paul,

    You're very kind thank you

    Yes that's true, 25 pairs (nobody would reach that .))

    In the WS rows contain product criteria, columns product id's.
    This function knows it's caller cell column and compares some product criteria in it ("x" or "", combined with AND/OR)

    So for example (please see below screenshot):

    Let's say i'd like to analyze/combine some of those product criteria in the rows below row 15, starting in cell C16

    ebene1-kriterien.jpg

    = PRODUKT0(A3) result: "x"

    = PRODUKT0(A3) = "x" result: True

    = PRODUKT0(A3; "x") result: True

    = AND(PRODUKT0(A3; "x"; A8; "x")) result: True


    PS. The main reason for this specific function is to compensate for the criteria numbers vs. row numbers...
    makes it much easier for the user. So, actually it doesnt matter if the argument is "A3" or "HEY3" or "LOL3" or something
    Last edited by nikki333; 06-19-2018 at 02:10 PM.

  13. #13
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,063
    Location
    This is just a concept to give you some ideas

    You can see the AND-ing and OR-ing in the attachment


    BTW, it's usually better to attach a small workbook that has data and shows the issue instead of a screen shoot so that people don't have to recreate test materials (if they're willing)


    Option Explicit
    
    
    
    Function PRODUKT0(r As Range, ParamArray Kriterium()) As Variant
        Dim iCol As Long, iRow As Long
        Dim iKrit As Long
        Dim v As Variant, vMatch As Variant
        Dim bOut() As Boolean
        
        iCol = Application.Caller.Column
        
        ReDim bOut(LBound(Kriterium) To UBound(Kriterium))
        
        For iKrit = LBound(Kriterium) To UBound(Kriterium)
            v = Split(Kriterium(iKrit), "=")
            
            'try v(0) as the string from Split()
            vMatch = Application.VLookup(v(0), r, iCol, False)
            
            'try v(0) as long
            If IsError(vMatch) Then vMatch = Application.VLookup(CLng(v(0)), r, iCol, False)
            
            If Not IsError(vMatch) Then bOut(iKrit) = (UCase(vMatch) = UCase(v(1)))
        Next iKrit
    
    
        PRODUKT0 = bOut
    End Function
    Attached Files Attached Files
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  14. #14
    VBAX Regular
    Joined
    Jul 2017
    Location
    Zurich
    Posts
    77
    Location
    Lookup.xlsm

    Thanks Paul

    I'm starting to understand a bit more. I was just about to modify your concept, but having starting difficulties:

    If I type for instance =PPRODUKT0($A1) what I'm excpecting the array to be is Kriterium(0) = "$A1"

    However, it returns the value of cell A1 (which is "Title" in your worksheet example).

    I need the range argument so that the formula doesn't break when users insert rows.

    So I thought something like this would help, but doesn't work: Function PRODUKT0(ParamArray Kriterium() as String) As Variant




    Function PRODUKT0(ParamArray Kriterium()) As Variant
    Dim iCol As Long, iRow As Long
    Dim iKrit As Long
    Dim v As Variant, vMatch As Variant
    Dim bOut() As Boolean
    .
    .
    .
    Last edited by nikki333; 06-20-2018 at 09:23 AM.

  15. #15
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,063
    Location
    Capture.JPGInserting rows will adjust formulas - normal Excel feature

    Attachment 22461


    I just made a simple example to show one way to use ParamArray by using a combined "CODENUM=X" format in each element of ParamArray

    You could also use an alternate where the CODE and the MATCH are separate to return an array of booleans

    Option Explicit
    
    
    ' =AND(PRODUKT0ALT($A$4:$G$22,3,"x",8,"x"))
    
    Function PRODUKT0ALT(r As Range, ParamArray Kriterium()) As Variant
        Dim iCol As Long, iRow As Long
        Dim iKrit As Long
        Dim vMatch As Variant
        Dim bOut() As Boolean
        
        iCol = Application.Caller.Column
        
        ReDim bOut(LBound(Kriterium) To UBound(Kriterium) / 2)
        
        For iKrit = LBound(Kriterium) To UBound(Kriterium) - 1 Step 2
            
            'try v(0) as the string from Split()
            vMatch = Application.VLookup(Kriterium(iKrit), r, iCol, False)
            
            'try v(0) as long
            If IsError(vMatch) Then vMatch = Application.VLookup(CLng(Kriterium(iKrit)), r, iCol, False)
            
            If Not IsError(vMatch) Then bOut(iKrit / 2) = (UCase(vMatch) = UCase(Kriterium(iKrit + 1)))
        Next iKrit
        PRODUKT0ALT = bOut
    End Function
    
    
    
    '   =AND(PRODUKT0($A$4:$G$22,"2=x","8=x"))
    
    Function PRODUKT0(r As Range, ParamArray Kriterium()) As Variant
        Dim iCol As Long, iRow As Long
        Dim iKrit As Long
        Dim v As Variant, vMatch As Variant
        Dim bOut() As Boolean
        
        iCol = Application.Caller.Column
        
        ReDim bOut(LBound(Kriterium) To UBound(Kriterium))
        
        For iKrit = LBound(Kriterium) To UBound(Kriterium)
            v = Split(Kriterium(iKrit), "=")
            
            'try v(0) as the string from Split()
            vMatch = Application.VLookup(v(0), r, iCol, False)
            
            'try v(0) as long
            If IsError(vMatch) Then vMatch = Application.VLookup(CLng(v(0)), r, iCol, False)
            
            If Not IsError(vMatch) Then bOut(iKrit) = (UCase(vMatch) = UCase(v(1)))
        Next iKrit
        PRODUKT0 = bOut
    End Function

    My example takes the 'Code' number from the first part of theParamArray element, matches that to the first column in the passed range to get the Row, and the Column number from .Caller to see if it matches the second part of the ParamArray element

    Why would you only pass a single part (e.g. $A1) since there's no 'Product' to check

    It could be modified to handle ranges or other types of data, but that gets complicated
    Attached Files Attached Files
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  16. #16
    VBAX Regular
    Joined
    Jul 2017
    Location
    Zurich
    Posts
    77
    Location

    Deleted attachment at OP's request

    Thanks again Paul

    I'm going into your example tomorrow...just to make my function purpose a bit clearer:

    The standard case would be that 1 to however many arguments are passed. eg. =OR(PRODUKT0($A1 = "x", $A6 = "")) in this expample if should return true if either Kriterium1 = x or if Kriterium6 = ""

    Then there should be the case where there's only one argument; and that's divided again into 2 options:

    1st: only one argument including an "=" like eg. =PRODUKT0($A1 = "x") should return true if Kriterium1 = "x"

    2nd: only one argument =PRODUKT0($A1) should return the cell value of Kriterium1; either "x" or "" or whatever is the value

    Attached please find my project file...with the long, but yet working functions to see what i'm trying to achieve

    ps. the function(s) in question only apply for wsProdukte
    Last edited by Paul_Hossler; 06-21-2018 at 02:59 PM.

  17. #17
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,063
    Location
    See if this is a little closer to what you were looking to do

    I extracted single worksheet for testing and you can see the function calls


    Option Explicit
    
    
    ' =AND(PRODUKT0(A3,"x",A8,"x"))
    
    Function PRODUKT0(ParamArray Kriterium()) As Variant
        Dim iCol As Long, iRow As Long
        Dim iKrit As Long
        Dim vMatch As Variant
        Dim bOut() As Boolean
        
        iCol = Application.Caller.Column
        
        'on parm passed
        If UBound(Kriterium) = 0 Then
            If TypeName(Kriterium(0)) = "Range" Then
                iRow = Kriterium(0).Row
                PRODUKT0 = Cells(iRow, iCol).Value
            Else
                PRODUKT0 = CVErr(xlErrNull)
            End If
        
            Exit Function
        End If
        
        
        'not pairs passed
        If UBound(Kriterium) Mod 2 <> 1 Then
            PRODUKT0 = CVErr(xlErrNum)
            
            Exit Function
        End If
        
        'pairs
        ReDim bOut(LBound(Kriterium) To (UBound(Kriterium) - 1) / 2)
        
        For iKrit = LBound(Kriterium) To UBound(Kriterium) - 1 Step 2
            
            If TypeName(Kriterium(iKrit)) = "Range" Then
                iRow = Kriterium(iKrit).Row
            Else
                PRODUKT0 = CVErr(xlErrNull)
                Exit Function
            End If
        
             bOut(iKrit / 2) = (UCase(Kriterium(iKrit + 1)) = UCase(Cells(iRow, iCol).Value))
        Next iKrit
        
        PRODUKT0 = bOut
    End Function
    Attached Files Attached Files
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •