vba - 如何使用多个过滤器从 Excel VBA 中的用户输入框数据进行复制

Question

我想通过输入框从用户那里获取超过 1 个输入并过滤表格。仅过滤一列。然后将整行数据复制到另一张纸上。我使用了下面的代码。问题是它可以用来过滤 1 个国家。

F 列中有很多国家/地区。我需要在输入框中输入 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

Answer 1

您可以循环读取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