Question

我有一个包含+ 100k行的大型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

从同一列中的活动自动过滤器中删除当前单元格的值

1 个答案: