Question

我想只过滤固定数量的数据。我正在实现在此WebPage上发布的代码并且它工作正常，但它会过滤包含＆＃34; Item1＆＃34;的所有数据。和＆＃34;批准＆＃34;。例如，我想要做的是使用给定条件仅过滤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方法之前将.CurrentRegion应用于.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

这两个人都在我的有限测试中幸存下来。如果遇到问题我会回复，但我没有说明。

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

1 个答案: