我有一个功能,可以从数据表中复制数据并将其粘贴到调用它的工作表中。请参阅以下内容:
Public Sub Barry()
Const DATA = "data!a1"
Const OUTPUT = "a3:c3"
Const FILTER_VALUE_ADDRESS = "d1"
Const FILTER_COLUMN = 4
Dim rCrit As Range, rData As Range
Set rData = Range(DATA).CurrentRegion
Set rCrit = rData.Resize(2, 1).Offset(, rData.Columns.Count + 2)
rCrit(1) = rData(1, FILTER_COLUMN): rCrit(2) = Range(FILTER_VALUE_ADDRESS)
rData.AdvancedFilter xlFilterCopy, rCrit, Range(OUTPUT)
rCrit.Clear
End Sub
现在它就像一个魅力,但我希望用户能够多次调用此方法通过单击一个分配了宏的按钮并在当前工作表中保持附加数据,尽管如此他们之间有一个空行。
使用上述方法,我无法锻炼如何做到这一点。
答案 0 :(得分:0)
将此例程分配给按钮:
Public Sub Barry2()
Const DATA = "data!a1"
Const OUTPUT = "a3:c3"
Const FILTER_VALUE_ADDRESS = "d1"
Const FILTER_COLUMN = 4
Dim rCrit As Range, rData As Range, rOut As Range
Set rData = Range(DATA).CurrentRegion
Set rCrit = rData.Resize(2, 1).Offset(, rData.Columns.Count + 2)
rCrit(1) = rData(1, FILTER_COLUMN): rCrit(2) = Range(FILTER_VALUE_ADDRESS)
With ActiveSheet.Range(OUTPUT)
Set rOut = .Offset(.Item(.Parent.Rows.Count).End(xlUp).Row - .Row + 2)
End With
rOut = Range(OUTPUT).Value
rData.AdvancedFilter xlFilterCopy, rCrit, rOut
rOut.Delete xlUp
rCrit.Clear
End Sub
注意:在运行此工作表之前,必须存在“摘要”表的第3行中的三个列标题。