Excel 如何使用VBA将IF条件添加到自动过滤器

您好，我在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编码新手

如果该公司不在您的列表中，它将对您的自动筛选没有影响，因为它将被过滤掉。但是，以下演示如何识别列表中的公司，以及更好的过滤/复制方法：

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行，则不执行您试图避免的步骤：

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

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

---

---

我正在重新考虑我是否正确理解了你的问题。如果上面的代码作为您问题的答案不合理，请给我留言，我将删除它。

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

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）。它将在用

Clm

标识的列中查找由

Id

标识的项。如果找到该项，它将被添加到返回数组中。如果未找到任何内容，则数组将返回空白（空）

当然，您可以根据需要将名称放入

选项

字符串中，可以放入任意数量的字符串，所有字符串都以逗号分隔（注意不必要的空格）。当然，您可以添加更多选择

您可以使用以下测试步骤测试此功能：-

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

如果不是IsEmpty（Arr），请观察该行。您还需要将其合并到代码中，因为如果

Arr

没有可用的选项，您就不希望应用过滤器

---

顺便说一句，我以最小的方式指定了

Find

方法。您可能希望扩展规范，以确保以前的手动搜索不会干扰我的代码使用的默认值。阅读MSDN上的

Find

方法。

您可能可以查看最后一行，如果是第1行，则不要执行您试图避免的步骤：

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

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

---

查看OnError实际上，代码的筛选行运行时没有给出任何错误，它只是添加了自动筛选，所有数据都隐藏了，除了第一行，因为“Criteria1”中的数据不存在。这是您不确定如何执行

范围（“A:H”）的问题.AutoFilter

在第一次筛选之后，在第二次筛选之前，将筛选重置为

范围（“A:H”）。AutoFilter字段：=9，准则1:=Array（“US”、“UK”、“AUS”），运算符：=xlFilterValues

？另外，复制和粘贴跨越隐藏自动筛选行的范围也会复制隐藏行我相信。。。您需要使用或@Wolfie-它应该只复制可见的单元格（至少，如果宏记录器没有，它会有一个bug。不，重复记录的宏仍然只复制可见的单元格。）