使用AutoFilter过滤固定数量的数据

我想只过滤一个固定数量的数据。 我正在实现在这个WebPage上发布的代码，它完美的工作，但它过滤所有包含“Item1”和“Approved”的数据。 例如，我想要做的是只用给定的条件过滤5行数据，而不是全部过滤。

Private Sub CommandButton1_Click() Dim OriginalData As Worksheet, FilteredData As Worksheet Set OriginalData = ThisWorkbook.Worksheets("Sheet1") Set FilteredData = ThisWorkbook.Worksheets("Sheet2") With OriginalData If .AutoFilterMode Then .AutoFilterMode = False With .Cells(2, 1).CurrentRegion .AutoFilter field:=1, Criteria1:="Item1" .AutoFilter field:=2, Criteria1:="Approved" With .Resize(.Rows.Count - 1, Columns.Count).Offset(1, 0) If CBool(Application.Subtotal(103, .Cells)) Then .Copy Destination:= _ FilteredData.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) End If End With End With If .AutoFilterMode Then .AutoFilterMode = False End With End Sub 

Answer 1

如果要过滤前5行，则可以在.AutoFilter方法之前将Range.Resize 属性应用于.CurrentRegion 。

 Private Sub CommandButton1_Click() Dim OriginalData As Worksheet, FilteredData As Worksheet Set OriginalData = ThisWorkbook.Worksheets("Sheet1") Set FilteredData = ThisWorkbook.Worksheets("Sheet2") With OriginalData If .AutoFilterMode Then .AutoFilterMode = False With .Cells(1, 1).CurrentRegion 'all cells radiating out from A1 'resize to 6 rows total (5 data + 1 header) With .Resize(6, .Columns.Count) .AutoFilter field:=1, Criteria1:="Item1" .AutoFilter field:=2, Criteria1:="Approved" With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0) If CBool(Application.Subtotal(103, .Cells)) Then .Copy Destination:= _ FilteredData.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) End If End With End With End With If .AutoFilterMode Then .AutoFilterMode = False End With End Sub 

请注意，如果您使用F8执行代码，则所有数据都将被实际过滤，但只有前5个（可见或不可见）行中的过滤数据将被复制。

如果你想复制前5个过滤的行，那么你需要处理不连续的可见的Range.Areas属性和一些math。

 Private Sub CommandButton2_Click() Dim a As Long, aa As Long Dim OriginalData As Worksheet, FilteredData As Worksheet Set OriginalData = ThisWorkbook.Worksheets("Sheet1") Set FilteredData = ThisWorkbook.Worksheets("Sheet2") aa = 5 With OriginalData If .AutoFilterMode Then .AutoFilterMode = False With .Cells(1, 1).CurrentRegion 'all cells radiating out from A1 .AutoFilter Field:=1, Criteria1:="Item1" .AutoFilter Field:=2, Criteria1:="Approved" With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0) If CBool(Application.Subtotal(103, .Cells)) Then With .SpecialCells(xlCellTypeVisible) For a = 1 To .Areas.Count .Areas(a).Resize(Application.Min(aa, .Areas(a).Rows.Count), .Columns.Count).Copy Destination:= _ FilteredData.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) aa = aa - Application.Min(aa, .Areas(a).Rows.Count) If aa < 1 Then Exit For Next a End With End If End With End With If .AutoFilterMode Then .AutoFilterMode = False End With End Sub 

这两个人幸免于我有限的testing。 如果遇到我没有考虑过的问题，请回复。