如何在Excel VBA中使用多重过滤器从用户输入框数据复制

我希望通过inputbox从用户处获得多个输入，并对表进行筛选。只过滤一列。然后将整行数据复制到另一张图纸上。我使用了下面的代码。问题是它可以用于过滤1个国家/地区

F列中有很多国家。我需要在inputbox中输入2个或更多国家。然后复制粘贴。我想添加循环。但是我不知道怎么做。帮帮我

Private Sub CommandButton1_Click()

Dim str1 As Variant
Dim Tbl As ListObject
Dim FiltRng As Range
Dim RngArea As Range

Set Tbl = Sheet1.ListObjects("DataTable")
str1 = Application.InputBox("Select the Country Code")

If str1 = False Then
    MsgBox "Please select one Country", , "Input"
Exit Sub

Else

Tbl.Range.AutoFilter Field:=6, Criteria1:=str1
For Each RngArea In Tbl.Range.SpecialCells(xlCellTypeVisible).Rows

If RngArea.Row > 1 Then
    If Not FiltRng Is Nothing Then
        Set FiltRng = Application.Union(FiltRng, RngArea)
    Else
        Set FiltRng = RngArea
    End If
End If

Next RngArea

If Not FiltRng Is Nothing Then
FiltRng.Copy Sheets("Sheet2").Range("A2")
End If

End If

Sheet1.ListObjects("DataTable").Range.AutoFilter Field:=6

End Sub

---

为什么不简单地用数据制作一个数据透视表，将数据透视表放在另一张表中，然后添加一个切片器，以便用户可以选择他们想要的国家？无需VBA。

使用以下子项，该子项采用两个条件来过滤表格，并将过滤后的数据复制到

表2

。您可以根据需要添加更多标准

Sub Filter2Criteria()
Dim str1, str2 As Variant
Dim Tbl As ListObject
Dim FiltRng As Range
Dim RngArea As Range

    Set Tbl = Sheet1.ListObjects("DataTable")

    str1 = Application.InputBox("Select the Country Code")
    str2 = Application.InputBox("Select the Country Code")

    If str1 = False Then
        MsgBox "Please select first Country", , "Input"
          Exit Sub
          ElseIf str2 = False Then
         MsgBox "Please select second Country", , "Input"
        Exit Sub
    End If

    Tbl.Range.AutoFilter Field:=6, Criteria1:=str1, Operator:=xlOr, Criteria2:=str2

    Set FiltRng = Tbl.Range.SpecialCells(xlCellTypeVisible)
    FiltRng.Copy Sheets("Sheet2").Range("A2")

End Sub

---

您可以在循环中读取InputBox。请尝试以下代码

Sub Macro3()
    Dim arr() As String
    Dim size As Long
    size = 1

    Do
        str1 = Application.InputBox("Select the Country Code")

        ReDim Preserve arr(size)
        arr(size) = str1
        size = size + 1
    Loop While (str1 <> vbNullString) And (str1 <> False)

    ActiveSheet.Range("$A$1:$F$5").AutoFilter Field:=6, Criteria1:=arr, Operator:=xlFilterValues
End Sub

Sub-Macro3（）
Dim arr（）作为字符串
尺寸和长度一样小
尺寸=1
做
str1=Application.InputBox（“选择国家代码”）
ReDim保留arr（大小）
arr（大小）=str1
尺寸=尺寸+1
循环While（str1 vbNullString）和（str1 False）
ActiveSheet.Range（“$A$1:$F$5”）。自动筛选字段：=6，准则1:=arr，运算符：=xlFilterValues
端接头

我不需要枢轴。我需要在VBAThe中执行这样的请求的起点应该是“启动宏记录器，执行过滤器，然后查看它输出的代码”。@jeffreyweir，就是这样的ActiveSheet.ListObjects（“DataTable”）.Range.AutoFilter字段：=6，Criteria1:=Array（“AT”、“BY”、“DE”、“FI”、“GI”），运算符：=xlFilterValues'谢谢。很好用。很高兴我能帮你。