为多个标准应用排除标准

时间:2013-11-21 13:58:42

标签: excel excel-vba vba

我正在尝试使用一些VBA代码来应用高级/自动过滤器来特别排除三个变量。例如,`在整个数据集中,隐藏列A具有值X,Y或Z的条目。

据我所知,此代码适用于包含

Sheets(sheetName).Range("$A:$" & finalCol).AutoFilter Field:=fieldIndex, criteria1:=Array("=" & crit1, "=" & crit2, "=" & crit3), Operator:=xlFilterValues

但这不适用于排除:

Sheets(sheetName).Range("$A:$" & finalCol).AutoFilter Field:=fieldIndex, criteria1:=Array("<>" & crit1, "<>" & crit2, "<>" & crit3), Operator:=xlFilterValues

数据验证码

Dim Arr() As Variant
Arr = Range(Cells(10, 2).Validation.Formula1)

For R = 1 To UBound(Arr, 1) 
    For C = 1 To UBound(Arr, 2) 
        Debug.Print Arr(R, C)
    Next C
Next R

有没有办法让这个数组像答案一样“一维”?

1 个答案:

答案 0 :(得分:0)

假设您的工作表看起来像这样

enter image description here

<强> LOGIC:

我们正在做的是创建我们想要的值数组,然后将该数组传递给自动过滤器。

<强> CODE:

试试此代码

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim Ar() As String, itm
    Dim Lrow As Long, n As Long, i As Long
    Dim rng As Range
    Dim Col As New Collection
    Dim TempAr
    Dim ExclusionList As String
    Dim doNotAdd As Boolean

    '~~> Exclusion List
    ExclusionList = "X,Y,Z"

    TempAr = Split(ExclusionList, ",")

    '~~> Change this to the relevant worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        .AutoFilterMode = False

        Lrow = .Range("A" & .Rows.Count).End(xlUp).Row

        Set rng = .Range("A1:A" & Lrow)

        '~~> Get unique collection of items
        For i = 2 To Lrow
            On Error Resume Next
            Col.Add .Range("A" & i).Value, CStr(.Range("A" & i).Value)
            On Error GoTo 0
        Next i

        '~~> Create an array which doesn't have the items that we don't need
        For Each itm In Col
            For i = LBound(TempAr) To UBound(TempAr)
                If itm = TempAr(i) Then
                    doNotAdd = True
                    Exit For
                End If
            Next

            If doNotAdd = False Then
                ReDim Preserve Ar(n)
                Ar(n) = itm
                n = n + 1
            End If

            doNotAdd = False
        Next

        '~~> Autofilter
        rng.AutoFilter Field:=1, Criteria1:=Ar(), Operator:=xlFilterValues
    End With
End Sub

<强>输出:

enter image description here