Question

我有一个类似数据库的大表，第一行包含标题。我想根据列值来获取此表的行的子集。两个问题：

1）VBA-wise我想循环遍历列，当所有必要列的值全部匹配时，将整行复制到新表中。

2）行的子集基于列表。我刚读过，我可以使用带有数组的Autofilter。是否可以从列中输入此数组而不是在VBA代码中手动输入？我使用的列表包含200个不同的字符串，并将定期更新。

其中CritList是字符串列表。我仍然需要弄清楚如何，但现在我离开办公室，明天更多。

EDIT1 感谢@DougGlancy;自动过滤现在有效。这是他漂亮的代码（我只添加了数组滤镜）。

EDIT2 包含更精细的数组过滤器，其中 NameList 是我想要过滤的列表。现在一切正常！

Sub FilterAndCopy()
Dim LastRow As Long

Dim vName As Variant
Dim rngName As Range
Set rngName = Sheets("Sheet3").Range("NameList")

vName = rngName.Value

Sheets("Sheet2").UsedRange.Offset(0).ClearContents
With Worksheets("Sheet1")
    .Range("A:E").AutoFilter

    'Array filter from NameList
    .Range("A:J").AutoFilter Field:=3, Criteria1:=Application.Transpose(vName), _
                                Operator:=xlFilterValues

    .Range("A:E").AutoFilter field:=2, Criteria1:="=String1" _
                                  , Operator:=xlOr, Criteria2:="=string2"
    .Range("A:E").AutoFilter field:=3, Criteria1:=">0", _
    .Range("A:E").AutoFilter field:=5, Criteria1:="Number"

    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Destination:=Sheets("Sheet2").Range("A1")

End With
End Sub

Answer 1

这是一种不同的方法。它的核心是通过打开宏记录器并根据您的规范过滤列来创建的。然后有一些代码来复制结果。它将比循环遍历每一行和列运行得更快：

Sub FilterAndCopy()
Dim LastRow As Long

Sheets("Sheet2").UsedRange.Offset(0).ClearContents
With Worksheets("Sheet1")
    .Range("$A:$E").AutoFilter
    .Range("$A:$E").AutoFilter field:=1, Criteria1:="#N/A"
    .Range("$A:$E").AutoFilter field:=2, Criteria1:="=String1", Operator:=xlOr, Criteria2:="=string2"
    .Range("$A:$E").AutoFilter field:=3, Criteria1:=">0"
    .Range("$A:$E").AutoFilter field:=5, Criteria1:="Number"
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Destination:=Sheets("Sheet2").Range("A1")
End With
End Sub

作为旁注，您的代码具有比必要更多的循环和计数器变量。您不需要遍历列，只需遍历行。然后，您将检查该行中感兴趣的各个单元格，就像您一样。

用于过滤列的VBA

1 个答案: