Excel高级过滤器动态范围

时间:2017-08-31 11:59:12

标签: excel vba excel-vba

我有一个内部网站的数据连接,它抓取一个完整的网页并将其导入到" DC"片。从那里开始,他们搬到了#34; staging"使用以下代码通过高级过滤器宏。 N1100不是带文本的最后一行,它是一个任意数字,距离我的数据末尾有一段距离。

Private Sub Worksheet_Change(ByVal Target As Range)
    Call Password_Unprotect

    Dim ws As Worksheet
        Set ws = ThisWorkbook.Sheets("DC")
    Dim lrng As Range
       Set lrng = ThisWorkbook.Sheets("DC").Range("A158:N1100")
    Dim crng As Range
        Set crng = ThisWorkbook.Sheets("DC").Range("A158:N1100")

    Dim copyto As Range
        Set copyto = ThisWorkbook.Sheets("Staging").Range("A1:H1")

    lrng.AdvancedFilter xlFilterCopy, crng, copyto, Unique:=False

    'Call password_protect  
End Sub

我的问题是,每当我用于数据连接的网页发生变化时,它都会破坏我的高级过滤器,因为我的标准行在轮班开始。我想要使​​高级过滤器足够智能,找到它需要启动的行,或者删除它上面的每一行,然后将数据移到" staging"片。值得注意的是,该单元包含" Division"在表格上是独一无二的。突出显示的行是高级过滤器的开头。

我已经上传了我的工作表 I've uploaded a snip-it of my worksheet.

1 个答案:

答案 0 :(得分:1)

以下代码可以帮助您获得所需内容。只需要运行Column A来查找DEVICE文本,然后将其用作开始,然后在.End(xlUp)上为最后一行执行Column A

另外请注意,请务必在所有工作表上使用Option Explicit,以确保始终声明变量。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Call Password_Unprotect

    Dim DCSheet As Worksheet
    Dim lrng As Range
    Dim crng As Range
    Dim copyto As Range
    Dim StartRow As Long
    Dim ColACell As Range
    Dim LastRow As Long
    Set DCSheet = ThisWorkbook.Sheets("DC")

    LastRow = DCSheet.Cells(DCSheet.Rows.Count, "A").End(xlUp).Row

    'Stopping at 300 will just save time if the text is not found
    'if it is possible that the start row could be further down then increase the number
    For Each ColACell In DCSheet.Range("A1:A300").Cells
        If ColACell.Text = "DEVICE" Then
            'Can have cross check for the IP text in Column B
            If ColACell.Offset(0, 1).Text = "IP" Then StartRow = ColACell.Row
        End If
    Next ColACell

    Set lrng = DCSheet.Range("A" & StartRow & ":N" & LastRow)
    Set crng = DCSheet.Range("A" & StartRow & ":N" & LastRow)
    Set copyto = ThisWorkbook.Sheets("Staging").Range("A1:H1")

    lrng.AdvancedFilter xlFilterCopy, crng, copyto, Unique:=False

    'Call password_protect

End Sub