使用Excel AdvancedFilter xlFilterCopy附加数据

时间:2015-10-19 14:14:53

标签: excel vba excel-vba

我有一个功能,可以从数据表中复制数据并将其粘贴到调用它的工作表中。请参阅以下内容:

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

现在它就像一个魅力,但我希望用户能够多次调用此方法通过单击一个分配了宏的按钮并在当前工作表中保持附加数据,尽管如此他们之间有一个空行。

使用上述方法,我无法锻炼如何做到这一点。

1 个答案:

答案 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行中的三个列标题。