VBA：设置一个等于过滤条件的数组

Question

目前我有已经过滤业务类型的数据。我想用另一列中的值填充一个数组，而不需要任何重复。换句话说，我想用另一列的过滤条件填充一个数组。

另一列中的过滤条件将根据选择的业务类型而改变，因此填充数组需要是动态的。

我在网上研究过这个，到目前为止只发现这个不起作用：

Dim tempArr As Variant

tempArr = Sheets("Sheet1").Filters.Criteria1

样本数据

buisUnit   ProfCenter
SHS        1
SHS        1
SHS        2
SHS        3
SHS        4
ALT        5
ALT        6
ALT        6
ALT        7

因此，如果我的数据在 buis unit = SHS 上过滤，我希望 tempArray = (1,2,3,4) 如果在 ALT 上过滤，我会想要 (5,6,7)

提前致谢。

Answer 1

请使用下一个功能。它需要引用“Microsoft Scripting Runtime”。如果您无法添加它（即使它非常简单），只需注释第一个声明行并取消注释第二个：

Function FilterArray(arr As Variant, strSearch As String) As Variant
    Dim dict As New Scripting.Dictionary
    'Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim i As Long, strKey As String
    For i = 1 To UBound(arr)
      If arr(i, 1) = strSearch Then
        strKey = arr(i, 1) & "|" & arr(i, 2)
        If Not dict.Exists(strKey) Then
           dict.Add strKey, arr(i, 2)
        End If
      End If
  Next i
   If dict.Count = 0 Then FilterArray = "": Exit Function
   FilterArray = dict.Items
End Function

下面会调用它：

Sub testFilterArr()
  Dim sh As Worksheet, arr As Variant, strSearch As String, lastRow As Long
  
   Set sh = ActiveSheet 'use here the necessary sheet
   lastRow = sh.Range("A" & Rows.Count).End(xlUp).Row
   arr = sh.Range("A2:B" & lastRow).Value
   strSearch = "SHS"
   arr = FilterArray(arr, strSearch)
   If IsArray(arr) Then
       Debug.Print Join(arr, ",")
   Else
       MsgBox "No any result for """ & strSearch & """..."
   End If
End Sub