2017-08-31 152 views
1

我有一个内部网站的数据连接,抓取完整的网页并将其导入到“DC”表。从那里它通过使用下面的代码通过高级过滤器宏移动到“分段”。 N1100不是包含文本的最后一行,它是一个任意数字,距离我的数据结束还有一段距离。Excel高级过滤器动态范围

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 

我的问题是,每当我用我的数据连接的网页改变它打破了我的高级过滤器,因为我的标准开始轮班行。我正在寻找使先进的过滤器足够智能以找到需要启动的行或删除其上的每一行,然后将数据移动到“分段”表。需要注意的是,包含“分区”的单元在表单上是唯一的。突出显示的行是高级过滤器的开始。

我已经上传了我的工作表中的一个小工具。
I've uploaded a snip-it of my worksheet.

+1

OFFSET&MATCH的组合应该能够帮助您确定一个起点,或者使用动态命名范围 – PeterH

回答

1

下面的代码应该为你找到你想要的。只需要运行Column A以查找DEVICE文本,然后将其用作开始,然后在Column A上为最后一行执行.End(xlUp)

另一个注意事项,请始终记住在所有工作表上使用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