Wie filtert man ein Array mit einer Arbeitsblattfunktion?

Question

ich nach einer Möglichkeit, ein Array mit einem ausgewerteten Ausdruck zu filtern, wie:

Dim arr1(), arr2(), arr3() 

arr1 = Array(1, 2, 3, 4, 5)   ' > [1, 2, 3, 4, 5] 

arr2 = Map(arr1, "Values() * 2")  ' > [2, 4, 6, 8, 10] 

arr3 = Filter(arr2, "Values() > 6") ' > [8, 10] 

Ich habe bereits implementiert, um die Map Funktion mit einem UDF und mit Application.Evaluate("INDEX(expression,)"), aber ich bin zu kämpfen, es zu machen Arbeit für Filter:

Private arr_() 

Public Function Values() As Variant() 
    Values = arr_ 
End Function 

Public Function Map(arr(), expression As String) As Variant() 
    arr_ = arr 
    Map = Application.Evaluate("INDEX(" & expression & ",)") 
End Function 

Public Function Filter(arr(), expression As String) As Variant() 
    arr_ = arr 
    Filter = Application.Evaluate("INDEX(Values(), " & expression & ")") 
End Function 

gibt es eine Möglichkeit andere als Looping/jeden Wert Verschiebung? Maby mit VLOOKUP?

Answer 1

Obwohl ich ein großer Fan von Arrays bin und den größten Teil der Arbeit an Excel-Einbauten delegiere, fand ich für diesen den am besten geeigneten Job in VBA unter Verwendung von Excel zu Evaluate den Ausdruck für Einzelstücke.

Public Function FilterArr(arr(), expression As String) 
    Dim match As Boolean, i As Long, val 
    ReDim ret(LBound(arr) To UBound(arr)) 
    i = LBound(arr) - 1 
    On Error Resume Next 
    For Each val In arr 
    match = False 
    match = Application.Evaluate(val & expression) 
    If match Then 
     i = i + 1 
     ret(i) = val 
    End If 
    Next 
    If i >= LBound(arr) Then 
    ReDim Preserve ret(LBound(arr) To i) 
    FilterArr = ret 
    End If 
End Function 

---

Sub test() 
    Dim arr1(), arr2(), arr3() 
    arr1 = Array(10, 20, 30, 40, 50) 
    arr3 = FilterArr(arr1, ">25") ' <--- usage like this 
    ' arr3 = (30, 40, 50) 
End Sub 

P. S. eine interessante Erweiterung wäre, mehrere Kriterien zuzulassen (d. h. AND ed zusammen) unter Verwendung eines ParamArray. Gute Kandidaten für die künftige Arbeit ...

Answer 2

Zuerst ändern Sie die Funktion der folgenden ...

Public Function Filter(arr(), sValues As String, sCriteria As String) As Variant() 
    Dim Cnt As Long 
    arr_ = arr 
    Cnt = Application.Evaluate("SUMPRODUCT(--(" & sValues & sCriteria & "))") 
    If Cnt > 0 Then 
    Filter = Application.Evaluate("TRANSPOSE(INDEX(SMALL(IF(" & sValues & sCriteria & "," & _ 
     sValues & "),ROW(INDEX(A:A,1):INDEX(A:A," & Cnt & "))),0))") 
    Else 
    Filter = Array() 
    End If 
End Function 

Dann rufen Sie es wie folgt ...