excel vba - 自动过滤后选择除标题外的所有过滤行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/38410056/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
excel vba - Select all filtered rows except header after autofilter
提问by devster
I'm trying to write a macro to do the following:
我正在尝试编写一个宏来执行以下操作：
- from Sheet1 watch the A column for the data I input;
- when I write something in a cell in the A column use that value to filter Sheet2;
- after the filter is done, copy everything except the column header from the second sheet into the first one, even if there are multiple values.
- 从 Sheet1 观看我输入的数据的 A 列；
- 当我在 A 列的单元格中写东西时，使用该值来过滤 Sheet2；
- 过滤完成后，即使有多个值，也将第二张工作表中除列标题外的所有内容复制到第一张工作表中。
I tried writing this:
我试着写这个：
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A:A")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
copy_filter Target
End If
End Sub
Sub copy_filter(Changed)
Set sh = Worksheets("Sheet2")
sh.Select
sh.Range("$A:$L43") _
.AutoFilter Field:=3, _
Criteria1:="=" & Changed.Value, _
VisibleDropDown:=False
Set rang = sh.Range("$A:$L43") _
.SpecialCells(xlCellTypeVisible)
rang.Offset(0, 0).Select
Selection.Copy
Worksheets("Sheet1").Select
Worksheets("Sheet1").Range(Changed.Address).Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
sh.Range("$A:$L43").AutoFilter
Application.CutCopyMode = False
End Sub
However when I copy the selection the header row gets copied as well, but using .Offset(1, 0) cuts the header and 1 additional row and doesn't account for cases when the filter returns no results.
但是，当我复制选择时，标题行也会被复制，但使用 .Offset(1, 0) 会剪切标题和 1 个附加行，并且不考虑过滤器不返回任何结果的情况。
How can I select every filtered rows except for the header?
如何选择除标题外的每个过滤行？
回答by
Use sh.UsedRangewill give you a dynamic range. Where as, sh.Range("$A$1:$L$5943")will not shrink and grow to match your dataset.
We can trim the header row off like this:
使用sh.UsedRange会给你一个动态范围。在那里，sh.Range("$A$1:$L$5943")不会缩小和增长以匹配您的数据集。
我们可以像这样修剪标题行：
Set rang = sh.UsedRange.Offset(1, 0)
Set rang = rang.Resize(rang.Rows.Count - 1)
But SpecialCells(xlCellTypeVisible)will throw a No cells were found.error if there is no data to return. So we'll have to trap the error like this:
但是如果没有要返回的数据SpecialCells(xlCellTypeVisible)会抛出No cells were found.错误。所以我们必须像这样捕获错误：
On Error Resume Next
Set rang = rang.SpecialCells(xlCellTypeVisible)
If Err.Number = 0 Then
End If
On Error GoTo 0
Sub copy_filter(Changed)
Dim rang As Range
Set sh = Worksheets("Sheet2")
sh.UsedRange.AutoFilter Field:=3, _
Criteria1:="=" & Changed.Value, _
VisibleDropDown:=False
Set rang = sh.UsedRange.Offset(1, 0)
Set rang = rang.Resize(rang.Rows.Count - 1)
On Error Resume Next
Set rang = rang.SpecialCells(xlCellTypeVisible)
If Err.Number = 0 Then
rang.Copy
Worksheets("Sheet1").Range(Changed.Address).Offset(0, 1).PasteSpecial Paste:=xlPasteValues
End If
On Error GoTo 0
sh.Cells.AutoFilter
Application.CutCopyMode = False
End Sub
