Excel VBA 过滤到带有条件的数组

Question

I am trying to filter table data into an array with criteria from a separate column within that table I can achieve this on a worksheet with a simple formula which creates a spilled array.

=FILTER(tblMain[Name],tblMain[At Work]=1)

The code I am trying does not work?

Sub myArraySub()
Dim myTable As ListObject
Dim myArray1 As Variant
Dim myArray2 As Variant
Dim myArray3 As Variant

'Set path for Table variable
    Set myTable = ActiveWorkbook.Worksheets("Main").ListObjects("tblMain")
'Create Array
    myArray1 = Application.Transpose(myTable.ListColumns("Name").DataBodyRange.Value)
    myArray2 = Application.Transpose(myTable.ListColumns("At Work").DataBodyRange.Value)
    myArray3 = Application.Filter(myArray1, myArray2 = 1)
End Sub

I am getting errors and going in circles trying to solve what should be a simple problem. I will then ultimately use the array to test other tables if the Name appears in the array. TIA

Answer 1

It's not possible to do this with this approach, mainly because in VBA you can't compare an array directly to a single value and return an array.

What you could do is use Evaluate with the formula you already have.

Sub myArraySub()
Dim myArray1 As Variant

    myArray1 = Evaluate("=FILTER(tblMain[Name],tblMain[At Work]=1)")

End Sub

Answer 2

In case you don't can't use very creative answer you got from @Norie in this thread, your question was also answered here extensively. But reading through all the solutions there I wondered whether they were worth the effort. So, here is a more plodding way of achieving the same result. It may well be your best bet if the number of rows in your table isn't very large.

Function MyArray() As Variant
    
    Dim Fun         As Variant          ' function return array
    Dim Arr         As Variant          ' working copy of entire table
    Dim Rs          As Long             ' loop counter: Arr (Source) rows
    Dim Rt          As Long             ' loop counter: Fun (Target) rows
    Dim C           As Long             ' loop counter: columns
    
    Arr = ActiveWorkbook.Worksheets("Main").ListObjects("tblMain").DataBodyRange.Value
    ReDim Fun(1 To UBound(Arr, 2), 1 To UBound(Arr))
    For Rs = 1 To UBound(Arr)
        If Arr(Rs, 2) = 1 Then
            Rt = Rt + 1
            For C = 1 To UBound(Arr, 2)
                Fun(C, Rt) = Arr(Rs, C)
            Next C
        End If
    Next Rs
    
    ReDim Preserve Fun(1 To UBound(Fun), 1 To Rt)
    MyArray = Application.Transpose(Fun)
End Function

Use the little procedure below for testing.

Sub Test_MyArray()

    Dim Arr     As Variant
    Dim R       As Long
    Dim C       As Long
    
    Arr = MyArray
    For R = 1 To UBound(Arr)
        For C = 1 To UBound(Arr, 2)
            Debug.Print Arr(R, C),
        Next C
        Debug.Print
    Next R
End Sub