有点忙碌，没有时间等待我澄清问题的答案，对不起。。
它看起来足以改变：

For r = 1 To UBound(arr)                                                'Loop through the elements of the array.
        For Each el In filter_Criteria
            If arr(r, 1) Like el Then dict(arr(r, 1)) = vbNullString: Exit For
        Next el
    Next r

其中：

For r = 1 To UBound(arr)                                                
        For Each El In filter_Criteria
            If arr(r, 1) Like El And arr(r, 1) Like Second_filter Then dict(arr(r, 1)) = vbNullString: Exit For
        Next El
    Next r

当然，Second_filter是一个字符串变量，它保留了你想要的值（“30”）...
即使它将在第一个过滤器之后运行（作为现有代码的结果），它也将作为第二步运行。
如果你想让它更快，你可以将dict声明为一个全局变量（在模块的顶部），并从现有代码中删除该声明。
然后，在第二步中使用它，在另一个字典中过滤...
要做到这一点，请测试下一个代码：

Sub Filter_the_Filtered_Column_After()
    Const filter_Column As Long = 2
    Dim Second_filter As String: Second_filter = "*30*"
    
    Dim ws As Worksheet:    Set ws = ActiveSheet
    
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
        
    Dim rg As Range
    Set rg = ws.UsedRange.Resize(ws.UsedRange.rows.count - 1).Offset(1)  '(UsedRange except the first Row)
    
    Dim r As Long, dict2 As Object
    Set dict2 = CreateObject("Scripting.Dictionary")                        'Write the matching strings to the keys (a 1D array) of a dictionary.
 
    For r = 0 To UBound(dict.keys)                                         'Loop through the elements of the array.
        If dict.keys()(r) Like Second_filter Then dict2(dict.keys()(r)) = vbNullString
    Next r

    If dict.count > 0 Then
        rg.AutoFilter field:=filter_Column, Criteria1:=dict2.keys, Operator:=xlFilterValues   'use the keys of the dictionary (a 1D array) as a Criteria
    End If

End Sub

当然，你应该初步检查是否not dict is nothing，在没有加载字典的情况下运行上述代码，或者在同时运行的中间过程中出现错误，你不得不关闭它。

编辑：

为了提取过滤器使用的数组，如果你不知道它（如你在评论中所问，请使用下一个函数：

Function extractFiltCriteria(sht As Worksheet, filtCol As Long) As Variant
    Dim arrFilt(), i As Long, fltRange As String
    
    With sht.AutoFilter
        fltRange = .Range.address
        With .Filters
            With .Item(filtCol)
                If .On Then
                    If IsArray(.Criteria1) Then
                        If .Operator = xlFilterValues Then
                            If IsArray(.Criteria1) Then extractFiltCriteria = Array(fltRange, .Criteria1, .Operator): Exit Function
                        End If
                    Else
                        ReDim arrFilt(1)
                        If .Criteria1 <> "" Then arrFilt(0) = .Criteria1
                        If .Criteria2 <> "" Then
                            arrFilt(1) = .Criteria2
                        Else
                            ReDim Preserve arrFilt(0)
                        End If
                            extractFiltCriteria = Array(fltRange, arrFilt, xlFilterValues): Exit Function
                    End If
                End If
            End With
        End With
    End With
    
    extractFiltCriteria = Array("") 'no any filter...
End Function

它可以在下一个适配代码中使用：

Sub Filter_the_Filtered_Column2()
   Dim filter_Criteria(), ws As Worksheet
   Const col As Long = 2, Second_filter As String = "*30*"
   
   Set ws = ActiveSheet
   
   If ws.AutoFilterMode = False Then MsgBox "No filter applied...": Exit Sub
   filter_Criteria = extractFiltCriteria(ws, col) 'extract filtered range, filter array and filter Operator
   If filter_Criteria(0) = "" Then MsgBox "No filter applied...": Exit Sub 

    Dim dict As Object, arr, El, mtch, r As Long
    Set dict = CreateObject("Scripting.Dictionary")
    
    arr = ws.Range(filter_Criteria(0)).Value2 'place in the array the extracted range which was previously filtered
    
    For r = 2 To UBound(arr)
        mtch = Application.match("=" & arr(r, col), filter_Criteria(1), 0)            'check if the array element matches the extracted filtering array
        If Not IsError(mtch) Then
            If arr(r, col) Like Second_filter Then dict(arr(r, col)) = vbNullString 'if a match exists and the array element contains Second_filter string
        End If
    Next r
     
     'refilter by the new dict.keys array:
    ws.Range(filter_Criteria(0)).AutoFilter col, dict.keys, Operator:=filter_Criteria(2)
End Sub

请测试一下，并发送一些反馈。应该是极快的……
但函数处理的正是这种情况：第二列中的数组过滤器。它可以被开发以满足所有可能的情况，但它将复杂得多。

如果你想把它作为一个单独的子，你可以试试这个：

Sub filteredRangeToArray()
    Const filter_Column As Long = 2
    
    Dim ws As Worksheet, arr(), rng As Range, newSh As Worksheet
    Dim lRow As Long, r As Long
    Dim nFilter As String: nFilter = "30"
    Dim dict As Object
    
    Set ws = ActiveWorkbook.ActiveSheet
    lRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    Set rng = ws.Range("A2:A" & lRow).SpecialCells(xlCellTypeVisible)
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set newSh = Worksheets.Add
    rng.Copy newSh.Range("A1")
    arr = newSh.Range("A1:A" & rng.Count).Value
    newSh.Delete
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    Set dict = CreateObject("Scripting.Dictionary")
    For r = 1 To UBound(arr, 1)
        If arr(r, 1) Like nFilter Then dict(arr(r, 1)) = vbNullString
    Next r
    
    If dict.Count > 0 Then
        rg.AutoFilter Field:=filter_Column, Criteria1:=dict.Keys, Operator:=xlFilterValues   'use the keys of the dictionary (a 1D array) as a Criteria
    End If
End Sub

但是现在我看到了FaneDuru关于将dict作为全局变量的评论，当然，这可能会更快/更容易。我会把我的答案留到你不想用的时候。

编辑：

Sub filteredRangeToArray_V2()
    Const filter_Column As Long = 2
    
    Dim ws As Worksheet, arr(), rng As Range, newSh As Worksheet
    Dim lRow As Long, r As Long
    Dim nFilter As String: nFilter = "*30*"
    Dim dict As Object
    Dim ccell As Range
    
    Set ws = ActiveWorkbook.ActiveSheet
    lRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    Set rng = ws.Range("A2:A" & lRow).Offset(0, filter_Column - 1).SpecialCells(xlCellTypeVisible)
    
    ReDim arr(1 To rng.Count)
    r = 1
    For Each ccell In rng.Cells
        arr(r) = ccell.Value
        r = r + 1
    Next ccell
    Set dict = CreateObject("Scripting.Dictionary")
    For r = 1 To UBound(arr, 1)
        If arr(r) Like nFilter Then dict(arr(r)) = vbNullString
    Next r
    
    Set rng = ws.UsedRange.Resize(ws.UsedRange.Rows.Count)
    rng.Select
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    If dict.Count > 0 Then
        rng.AutoFilter Field:=filter_Column, Criteria1:=dict.Keys, Operator:=xlFilterValues   'use the keys of the dictionary (a 1D array) as a Criteria
    End If
End Sub

这应该适应不需要另一个表/帮助列。