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

Question

我只想过滤固定数量的数据。我正在执行此网页上发布的代码，它运行良好，但它过滤了所有包含 "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 行，则使用 Range.Resize property can be applied to the .CurrentRegion before the .AutoFilter 方法。

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 property 和一些数学运算。

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

这两个都通过了我的有限测试。 Post如果你运行遇到问题我还没有占回来

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

Filter a fixed amount of data using AutoFilter

excel

vba

autofilter