从同一列的活动自动筛选中删除当前单元格的值

Question

我有一张包含+1000行的Excel大表，并对一列包含类别号和描述的文本值进行了自动筛选。F列中有数千个不同的值，因此使用标准UI更新自动过滤器是非常不切实际的。

如何创建一个宏，从同一列上活动的自动筛选中删除当前活动单元格的值？

Answer 1

在一位专家的帮助下，我们为我的案例找到了一个有效的解决方案。
只是将此作为其他人的解决方案发布：

Sub Clear_Filter_and_Value()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim w As Worksheet
Dim filterArray()
Dim currentFiltRange As String
Dim col As Integer
Dim flag As Boolean
Set w = ActiveSheet
If w.AutoFilterMode = False Then Selection.AutoFilter
flag = False
On Error GoTo exit1
With w.AutoFilter
    currentFiltRange = .Range.Address
    With .Filters
        For f = 1 To .Count
            With .Item(f)
                If .On Then
                    If ActiveCell.Column = f Then
                        ReDim filterArray(1 To .Count)
                        If .Count = 2 Then
                            filterArray(1) = .Criteria1
                            filterArray(2) = .Criteria2
                        Else
                            filterArray(1) = .Criteria1
                        End If
                    End If
                ElseIf ActiveCell.Column = f Then
                    tR = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
                    ReDim filterArray(1 To tR - 1)
                    For i = 2 To tR
                        filterArray(i - 1) = Cells(i, ActiveCell.Column).Value
                        flag = True
                    Next i
                End If
            End With
        Next f
    End With
End With
w.AutoFilterMode = False

j = 1
ReDim newArray(1 To UBound(filterArray))
If flag = False Then
    On Error GoTo 1
    For i = 1 To UBound(filterArray(1))
        On Error GoTo 1
        If InStr(1, filterArray(1)(i), ActiveCell.Value) = 0 Then
            newArray(j) = filterArray(1)(i)
            j = j + 1
        End If
    Next i
Else
1:
    Err.Clear
    For i = 1 To UBound(filterArray)
        If InStr(1, filterArray(i), ActiveCell.Value) = 0 Then
            newArray(j) = filterArray(i)
            j = j + 1
        End If
    Next i
End If
For col = 1 To 1
    If Not IsEmpty(filterArray(1)) Then
        w.Range(currentFiltRange).AutoFilter Field:=ActiveCell.Column,     Criteria1:=newArray, Operator:=xlFilterValues
    End If
Next col
exit1:
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub