Excelの高度なフィルタのダイナミックレンジ

Question

フルウェブページを取得して「DC」シートにインポートする内部ウェブサイトへのデータ接続があります。そこから、次のコードを使用して高度なフィルタマクロを使用してステージングに移動します。 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 

私の問題は、私は私のデータ接続に使用するWebページが変更されるたびに、それは私の基準がシフトに始まり、行以来、私の高度なフィルタを壊すということです。私は高度なフィルタを開始する必要がある行を見つけ出すために十分スマートにするか、上のすべての行を削除してから、「ステージング」シートにデータを移動します。注目すべき点は、 "Division"を含むセルがシート上で一意であることです。強調表示された行は、詳細フィルタの開始点です。

私は自分のワークシートのsnit-itをアップロードしました。

Answer 1

以下のコードは、あなたが探しているものを手に入れます。 Column Aを実行してデバイスのテキストを探し、それを開始として使用してから、最後の行の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