如何使用VBA将IF条件添加到自动筛选器

时间:2017-05-05 10:06:58

标签: excel-vba vba excel

您好,我在A栏中列出了公司名称,我将选择一些公司自动过滤器,然后使用该数据 - 我可以使用以下代码执行此操作,但是问题出现了特定的公司名称不在列表本身 - 但我仍然需要使用其余的步骤

Sub Test() 
   Sheets("Sheet1").Select
    Range("A:H").Select
    Selection.AutoFilter
    ' here i need a if condtion so that if the company is it not in the list then it should go to the line 20 and continue the macro else continue with the next line itself 
    Selection.AutoFilter Field:=1, Criteria1:=Array("JTKPV LLC", "Living Inc."), Operator:=xlFilterValues
 ' If filter is false (i.e) if the company name is not present then it should skip the following line of codes 
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Sheets("Sheet3").Select
    Range("A1").Select
    ActiveSheet.Paste ' Till here and then continue the next line of code

    Sheets("Sheet1").Select
    Selection.AutoFilter 'this will release the existing filter
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.AutoFilter ' this will place a new filter
    Range("A1").Select
   Selection.AutoFilter Field:=9, Criteria1:=Array("US", "UK", "AUS"), Operator:=xlFilterValues
   Selection.AutoFilter Field:=8, Criteria1:=">10.00", Operator:=xlAnd
 ' And few more codes 
End Sub

我希望我已解释过自己,请原谅我因为我是VBA编码新手而犯的任何错误

4 个答案:

答案 0 :(得分:0)

如果公司不在您的列表中,它将对您的自动过滤器没有任何影响,因为它将被过滤掉。但是,这里有一个演示如何识别列表中的公司以及更好的方法来过滤/复制它们到另一张表:

Sub Test()
    ' Use With to avoid Select
    With ThisWorkbook.Sheets("Sheet1")
        Dim companyArray As Variant
        companyArray = Array("JTKPV LLC", "Living Inc.")
        Dim inField1 As String
        Dim notInField1 As String
        Dim n As Long
        Dim found As Range
        ' Loop over companies, see if they are in
        For n = 0 To UBound(companyArray)
            Set found = .Columns("A").Find(what:=companyArray(n), lookat:=xlWhole)
            If found Is Nothing Then
                ' Create list of companies not in column A
                notInField1 = notInField1 & "," & companyArray(n)
            Else
                ' Create list of companies in column A
                inField1 = inField1 & "," & companyArray(n)
            End If
        Next n
        ' Filter based on column 1, for names in the inField1 list
        .Range("A:H").AutoFilter
        .Range("A:H").AutoFilter Field:=1, Criteria1:=Split(inField1, ","), Operator:=xlFilterValues
        ' Copy to another sheet
        Intersect(.UsedRange, .Range("A:H")).Copy Destination:=ThisWorkbook.Sheets("Sheet3").Range("A1")

        ' Filter based on column
        .Range("A:H").AutoFilter
        ' ...
    End With
End Sub

如果阵列中没有公司存在,那么您可以使用

If inField1 = "" Then
   ' none of the companies were present
End If

避免过滤和复制/粘贴操作。

答案 1 :(得分:0)

您可以查看哪一个是最后一行,如果是第1行,则不执行您要避免的步骤:

date:14 march 2016
2042
date:14 march 2016
2000
date:15 march 2016
1500
date:15 march 2016
1501
date:15 march 2016
1600

我想知道我是否 正确地理解了你的问题。如果上面的代码不能作为您问题的答案,请给我留言,我会将其删除。

答案 2 :(得分:0)

您可以使用以下函数返回的数组指定Criteria1

Private Function FilterArray(Id As Integer, _
                             Clm As Long) As Variant

    Dim Fun() As Variant                  ' Function result
    Dim Choices As String
    Dim Sp() As String
    Dim Rng As Range
    Dim i As Integer, n As Integer

    Select Case Id
        Case 0
            Choices = "JTKPV LLC,Living Inc.,Test item not to be found"
        Case 1
            Choices = "US,UK,AUS"
    End Select
    Sp = Split(Choices, ",")
    ReDim Fun(UBound(Sp))

    n = -1
    Set Rng = ActiveSheet.Columns(Clm)
    For i = 0 To UBound(Sp)
        If Not Rng.Find(Sp(i)) Is Nothing Then
            n = n + 1
            Fun(n) = Sp(i)
        End If
    Next i

    If n >= 0 Then
        ReDim Preserve Fun(n)
        FilterArray = Fun
    End If
End Function

此功能可以多次使用。它需要两个参数,字符串序列(0表示公司名称,1表示国家/地区)和列号(1表示A,9表示I)它将在标识为{的列中查找由Id标识的项目{1}}。如果找到该项,它将被添加到返回数组中。如果未找到任何内容,则数组将返回空白(空)。

当然,您可以根据需要将名称放入Clm字符串中,尽可能多地使用逗号分隔(注意不必要的空格)。当然,您可以添加更多选择。

您可以使用此测试程序测试此功能: -

Choices

观察行Private Sub TestFilterArray() Dim Arr As Variant Dim i As Integer Arr = FilterArray(0, 1) If Not IsEmpty(Arr) Then For i = 0 To UBound(Arr) Debug.Print i, Arr(i) Next i End If End Sub 。您还需要将其合并到代码中,因为如果If Not IsEmpty(Arr)没有可用的选项,您就不希望应用过滤器。

BTW,我以最小的方式指定了Arr方法。您可能希望扩展规范以确保先前的手动搜索不会干扰我的代码使用的默认值。阅读MSDN上的Find方法。

答案 3 :(得分:0)

您可能会看到哪一行是最后一行,如果是第一行,则不要执行您要避免的步骤:

Sub Test() 
    Dim lastRow As Long
    With Sheets("Sheet1").Range("A:H")
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:=Array("JTKPV LLC", "Living Inc."), Operator:=xlFilterValues
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 
        If lastRow > 1 Then
            .Range("A1:H" & lastRow).Copy Sheets("Sheet3").Range("A1")
        End If

        .AutoFilter
        .AutoFilter Field:=9, Criteria1:=Array("US", "UK", "AUS"), Operator:=xlFilterValues
        .AutoFilter Field:=8, Criteria1:=">10.00", Operator:=xlAnd
        ' And few more codes 
    End With
End Sub