Làm thế nào để lọc một mảng có chức năng bảng tính?

Question

Tôi đang tìm kiếm một cách để lọc một mảng với một biểu thức đánh giá như:

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] 

tôi đã thực hiện các chức năng Map với một UDF và với Application.Evaluate("INDEX(expression,)"), nhưng tôi đang đấu tranh để làm cho nó làm việc cho 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 

Có cách nào khác hơn là lặp/dịch chuyển từng giá trị không? Maby với VLOOKUP?

Answer 1

Mặc dù tôi là một fan hâm mộ lớn của mảng và ủy thác hầu hết công việc cho Excel được xây dựng trong, cho điều này tôi thấy rằng thích hợp nhất là làm công việc chính trong VBA, sử dụng Excel để Evaluate biểu thức cho các mục riêng lẻ.

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 

tái bút: một tiện ích mở rộng thú vị sẽ là cho phép nhiều tiêu chí (ví dụ: AND chỉnh sửa cùng nhau) bằng cách sử dụng ParamArray. Tốt ứng cử viên cho công việc tương lai ...

Answer 2

Đầu tiên thay đổi các chức năng như sau ...

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 

Sau đó gọi nó là như thế này ...