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

【问题标题】：Excel VBA filter to Array with criteriaExcel VBA过滤器到带有条件的数组
【发布时间】：2021-07-01 01:42:06
【问题描述】：

我正在尝试将表数据过滤到具有来自该表中单独列的条件的数组中我可以使用创建溢出数组的简单公式在工作表上实现这一点。

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

我尝试的代码不起作用？

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

我遇到了错误，并在试图解决应该是一个简单的问题时绕圈子。如果名称出现在数组中，我最终将使用该数组来测试其他表。 TIA

【问题讨论】：

标签： arrays excel vba criteria

【解决方案1】：

如果您不能在此线程中使用从@Norie 获得的非常有创意的答案，您的问题也是answered here 广泛。但是通读那里的所有解决方案，我想知道它们是否值得付出努力。因此，这是实现相同结果的更繁琐的方法。如果表中的行数不是很大，这可能是您最好的选择。

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

使用下面的小程序进行测试。

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

【讨论】：

感谢您的回复。 @norie 提供的解决方案非常适合我想要实现的目标:)

【解决方案2】：

用这种方法不可能做到这一点，主要是因为在 VBA 中你不能直接将数组与单个值进行比较并返回一个数组。

您可以做的是使用 Evaluate 与您已有的公式。

Sub myArraySub()
Dim myArray1 As Variant

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

End Sub

【讨论】：

谢谢@norie。效果很好:)