VBA：复制前 20 行过滤数据失败答案

【问题标题】：VBA: failed to copy the first 20 rows of filtered dataVBA：复制前 20 行过滤数据失败
【发布时间】：2021-03-15 00:31:03
【问题描述】：

我正在阅读以下post 并尝试从过滤表中复制前 20 行（不包括标题）。但是，最后一行给了我一个错误。我在这里做错了什么？

Sub Macro1()
'
' Macro1 Macro
'

'

    Dim wb As Workbook
    Dim ws As Worksheet
    
    Set wb = ActiveWorkbook
    Set ws = ThisWorkbook.Sheets("HelloWorld")
    wb.Activate
    ws.Activate

    ws.AutoFilterMode = False
    
    If ws.Range("A1:L11470").AutoFilter Then
        ws.Range("A1:L11470").AutoFilter
    End If
    ws.Range("A1:L11470").AutoFilter
    ws.AutoFilter.Sort.SortFields.Add2 Key:=Range("G1:G11470"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ws.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ws.Range("$A$1:$L$11470").AutoFilter Field:=11, Criteria1:="<>-"
    ws.Range("$A$1:$L$11470").AutoFilter Field:=1, Criteria1:="10", Operator:=xlTop10Items   ' <-- Error here
End Sub

错误如下：

【问题讨论】：

标签： excel vba copy

【解决方案1】：

我想我会采取稍微不同的方法来实现您似乎正在寻找的目标。下面建议的代码根据我对您问题的解释执行以下操作：

按列 G 对工作表“HelloWorld”上的数据范围 A:L 进行排序
设置过滤器，使 A 列 = 10，K 列 “-”
计算 HelloWorld 工作表中前 20 个已过滤（可见）的行并将它们复制（在此演示中复制到 Sheet2）

如果这不是您想要的，请发表评论，我会做出相应调整。

Option Explicit
Sub TestTop20()
Dim ws As Worksheet, c As Range, i As Integer, LastRow As Long, EndData As Long

Set ws = ThisWorkbook.Sheets("HelloWorld")

'Determine the last 'possible' row of data
LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

'Sort your data on column G
ws.Columns("A:L").Sort _
Key1:=ws.Range("G2"), order1:=xlDescending, Header:=xlYes

'Set the filter on columns K & A
With ws.Range("A1")
    .AutoFilter
    .AutoFilter Field:=1, Criteria1:="=10"
    .AutoFilter Field:=11, Criteria1:="<>-"
End With

'Determine what the last visible row is - up to 20
i = 0
For Each c In ws.Range("A2:A" & LastRow)
    If c.EntireRow.Hidden = False Then
        i = i + 1
            If i = 20 Then
                EndData = c.Row
                Exit For
            End If
    End If
Next c

If EndData < 20 Then MsgBox "Less than 20 records were detected"

'Copy the first 20 filtered records
ws.Range("A2:A" & EndData).SpecialCells(xlCellTypeVisible) _
.EntireRow.Copy Sheet2.Range("A1")

ws.AutoFilterMode = False
Application.Goto ws.Range("A1")

End Sub

【讨论】：