选择 VBA 中第 10 行可见单元格已过滤 Table
Selecting 1st 10 Rows of visible Cells in VBA Filtered Table
编码新手和 VBA 这是我第一次尝试 Select 并复制 第 10 行可见数据 以及table Header 在我使用 VBA 宏过滤的 Table 中。我在 Whosebug 上使用了 link 中的代码示例。 。这个特殊的例子让我学会了如何复制单个列中的值。我想复制整行或某些列的值,具体取决于哪个更容易。
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
您可以考虑使用循环来逐行查找并找到符合条件的前十行,而不使用过滤器。
除非您需要过滤器以特定方式向用户直观显示数据,否则循环可能更灵活且更易于编码。
您也可以考虑将您的值存储在变量中而不是使用复制粘贴 - 我个人觉得当宏擦除我的剪贴板时有点烦人:)
我通常使用此页面来参考 vba 中的循环语法:
http://www.excel-easy.com/vba/loop.html
我删除了您的一些代码,以使此示例更易于理解。
' 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...
开始的行将 table 限制为前 10 条记录。
以 sourceLO.Range.SpecialCells...
开头的行仅复制可见行(即前 10 行)。如果要将 copy/paste 限制为某些列,请使用以下语法:
Range("tblData[Header 1], tblData[Header 2]").SpecialCells(xlCellTypeVisible).Copy
编码新手和 VBA 这是我第一次尝试 Select 并复制 第 10 行可见数据 以及table Header 在我使用 VBA 宏过滤的 Table 中。我在 Whosebug 上使用了 link 中的代码示例。
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
您可以考虑使用循环来逐行查找并找到符合条件的前十行,而不使用过滤器。
除非您需要过滤器以特定方式向用户直观显示数据,否则循环可能更灵活且更易于编码。
您也可以考虑将您的值存储在变量中而不是使用复制粘贴 - 我个人觉得当宏擦除我的剪贴板时有点烦人:)
我通常使用此页面来参考 vba 中的循环语法: http://www.excel-easy.com/vba/loop.html
我删除了您的一些代码,以使此示例更易于理解。
' 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...
开始的行将 table 限制为前 10 条记录。
以 sourceLO.Range.SpecialCells...
开头的行仅复制可见行(即前 10 行)。如果要将 copy/paste 限制为某些列,请使用以下语法:
Range("tblData[Header 1], tblData[Header 2]").SpecialCells(xlCellTypeVisible).Copy