在 VBA 过滤表中选择第一 10 行可见单元格

Posted 2023-03-10

【中文标题】在 VBA 过滤表中选择第一 10 行可见单元格

【英文标题】：Selecting 1st 10 Rows of visible Cells in VBA Filtered Table

【发布时间】：2018-07-02 08:05:03

【问题描述】：

编码和 VBA 的新手，这是我第一次尝试选择和复制 第 10 行可见数据以及表格 Header 在一个表格中我已经使用 VBA 宏进行了过滤。我在***上的这个链接中使用了代码示例。 VBA selecting visible cells after filtering。这个特定的示例使我能够学习如何复制单个列中的值。我想复制整行或某些列的值，具体取决于哪个更容易。

Sub LPRDATA()


Dim TYEAR    As String
TYEAR = Range("TYEAR").Value
Dim QUARTER    As String
QUARTER = Range("QUARTER").Value
Dim r As Range, rC As Range
Dim j As Long


Sheets("CONTROL").Select
Sheets("DATA").Visible = True
Sheets("CONTROL").Select
Sheets("10").Visible = True
Sheets("DATA").Select
    ActiveWorkbook.Worksheets("DATA").ListObjects("tblData").Sort.SortFields.Clear
     ActiveWorkbook.RefreshAll
     Range("tblData[[#Headers],[Sn '#]]").Select

Range("tblData[[#Headers],[Year]]").Select
Selection.AutoFilter
ActiveSheet.ListObjects("tblData").Range.AutoFilter Field:=2, Criteria1:="LPR"
ActiveSheet.ListObjects("tblData").Range.AutoFilter Field:=12, Criteria1:=TYEAR
ActiveSheet.ListObjects("tblData").Range.AutoFilter Field:=15, Criteria1:=QUARTER


ActiveWorkbook.Worksheets("DATA").ListObjects("tblData").Sort.SortFields.Add _
    Key:=Range("tblData[[#All],[Score]]"), SortOn:=xlSortOnValues, Order:= _
    xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DATA").ListObjects("tblData").Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Set r = Nothing
Set rC = Nothing
j = 0
Set r = Range("C1", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)

For Each rC In r
j = j + 1
If j = 11 Or j = r.Count Then Exit For
Next rC

Range(r(1), rC).SpecialCells(xlCellTypeVisible).Copy
Sheets("10").Select
Range("C7").Select
ActiveSheet.Paste


End Sub

【问题讨论】：

嗨。未经测试，但你想要这样的东西：Range(r, r.End(xlDown).End(xlToRight)).SpecialCells(xlCellTypeVisible).Copy。这会将所有可见单元格从 r （如果我正确阅读您的代码是表格的左上行）复制到表格的右下角（2 .Ends 找到此位置）。一个好的提示是使用macro recorder。您可以使用它来将手动操作转换为 VBA。非常方便。

我最初使用的是宏记录器，但它定义了确切的数据，例如 A1:X345，而不是可见数据的前 10 行。谢谢。

【参考方案1】：

我已经删除了您的一些代码，以使这个示例更易于理解。

' Sorts a table in Excel.
' Then filters table for first 10 records.
' Then copies/pastes.
Sub Example()
    Dim sourceWS As Worksheet       ' Spreadsheet that contains the table.
    Dim sourceLO As ListObject      ' Table that contains the data.
    Dim targetRange As Range        ' Where to copy data to.

    ' Populate vars.
    Set sourceWS = ActiveSheet
    Set sourceLO = sourceWS.ListObjects("tblData")
    Set targetRange = Range("10!C7")

    ' Sort the table.
    With sourceLO.Sort
        .SortFields.Add Range("tblData[[#All], [Score]]"), xlSortOnValues, xlDescending
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ' Limit to first ten rows (update field to select limiting column).
    sourceLO.Range.AutoFilter Field:=1, Criteria1:="10", Operator:=xlTop10Items

    ' Copy currenlty visible cells.
    sourceLO.Range.SpecialCells(xlCellTypeVisible).Copy
    targetRange.PasteSpecial (xlPasteAll)
End Sub

以sourceLO.Range.AutoFilter... 开头的行将表格限制为前 10 条记录。

以sourceLO.Range.SpecialCells... 开头的行仅复制可见行（即前 10 行）。如果您想将复制/粘贴限制在某些列，请使用以下语法：

Range("tblData[Header 1], tblData[Header 2]").SpecialCells(xlCellTypeVisible).Copy

【参考方案2】：

您可以考虑改为使用循环逐行遍历并找到与您的条件匹配的前十行，而不使用过滤器。

除非您需要过滤器以特定方式向用户直观地显示数据，否则循环可能更灵活且更易于编码。

您还可以考虑将值存储在变量中，而不是使用复制粘贴 - 我个人觉得当宏擦除我的剪贴板时有点烦人 :)

我通常使用此页面来参考 vba 中循环的语法： http://www.excel-easy.com/vba/loop.html

【讨论】：

谢谢布里奇特

谢谢布里奇特。我理解这种方法。我的目标是找出今年、本季度此类报告类型的前 10 名得分。不幸的是，我不知道如何在 VBA 中做到这一点。我试着用公式来做，但是虽然我可以确定前 10 个分数，但我无法获得该行的其余部分（即使使用索引和匹配），因为我的分数中有重复的值。

看起来下面的 destination-data 的响应在这种情况下是完美的:)