2017-08-31 159 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