過濾掉原始數據報告通過基本的宏

我試圖採取精細過濾和刪除，我必須每天都做同一個原始數據報告中關於減少時儘可能多的它，因爲我可以到一個單一的按鈕單擊。過濾掉原始數據報告通過基本的宏

我相信我已經做了最該通過一個簡單的錄製的宏（如下圖所示），但它會在某些項目有時會離開的，我想刪除的項目。看看這段代碼，我認爲這可能歸因於這樣一個事實，即當宏正在應用過濾器時，它試圖刪除內容時所尋找的起始行並不固定。所以我的問題是，我應該只使用基於當前擁有過濾器的行的偏移值？或者這不會工作？

當我刪除標準「POR」「<> BGR」和「=日出地球」時出現問題我認爲這是因爲這些命令後面的選擇函數具有可能不總是可變的行號是真的

Sub ProgMisr() 
' 
' ProgMisr Macro 
' 
' Keyboard Shortcut: Ctrl+Shift+M 
' 
    Columns("A:A").Select 
    Selection.Delete Shift:=xlToLeft 
    ActiveWindow.ScrollColumn = 2 
    Range("I:I,K:K,L:L").Select 
    Range("L1").Activate 
    Selection.Delete Shift:=xlToLeft 
    ActiveWindow.ScrollColumn = 1 
    Range("B6").Select 
    Selection.AutoFilter 
    ActiveSheet.Range("$A$6:$I$5761").AutoFilter Field:=2, Criteria1:="<>EHD*" _ 
     , Operator:=xlAnd, Criteria2:="<>ESD*" 
    Rows("7:7").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$1412").AutoFilter Field:=2 
    Range("F3").Select 
    ActiveSheet.Range("$A$6:$I$1412").AutoFilter Field:=6, Criteria1:=Array(_ 
     "Missing Audio", "Missing Audio/Subs", "Missing Subs"), Operator:= _ 
     xlFilterValues 
    ActiveSheet.Range("$A$6:$I$1412").AutoFilter Field:=3, Criteria1:="=DCBU", _ 
     Operator:=xlOr, Criteria2:="=TLBA" 
    ActiveSheet.Range("$A$6:$I$1412").AutoFilter Field:=7, Criteria1:="=" 
    Rows("13:13").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$1069").AutoFilter Field:=7 
    Range("H1").Select 
    ActiveSheet.Range("$A$6:$I$1069").AutoFilter Field:=8, Criteria1:="<>*BGR*" _ 
     , Operator:=xlAnd 
    Rows("66:66").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$1059").AutoFilter Field:=8 
    ActiveSheet.Range("$A$6:$I$1059").AutoFilter Field:=3 
    ActiveSheet.Range("$A$6:$I$1059").AutoFilter Field:=7, Criteria1:="POR" 
    Rows("12:12").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$809").AutoFilter Field:=7 
    ActiveSheet.Range("$A$6:$I$809").AutoFilter Field:=6, Criteria1:= _ 
     "Missing Subs" 
    Rows("7:7").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$133").AutoFilter Field:=6, Criteria1:= _ 
     "=Missing Audio", Operator:=xlOr, Criteria2:="=Missing Audio/Subs" 
    Range("F2").Select 
    ActiveSheet.Range("$A$6:$I$133").AutoFilter Field:=1, Criteria1:= _ 
     "=*Sunrise Earth*", Operator:=xlAnd 
    Rows("17:17").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$112").AutoFilter Field:=1 
    ActiveSheet.Range("$A$6:$I$112").AutoFilter Field:=7, Criteria1:="ENG" 
    ActiveSheet.Range("$A$6:$I$112").AutoFilter Field:=3, Criteria1:=Array(_ 
     "AHPL", "APPL", "CIPO", "DPOL", "IDPL", "SCPO", "TLPO", "WOIT"), Operator:=xlFilterValues 
    Rows("7:7").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$55").AutoFilter Field:=3 
    Range("B11").Select 
End Sub

編輯：新宏代碼

Sub ProgMisr() 
' 
' ProgMisr Macro 
' 
' Keyboard Shortcut: Ctrl+Shift+M 
' 
    Columns("A:A").Select 
    Selection.Delete Shift:=xlToLeft 
    ActiveWindow.ScrollColumn = 2 
    Range("I:I,K:K,L:L").Select 
    Range("L1").Activate 
    Selection.Delete Shift:=xlToLeft 
    ActiveWindow.ScrollColumn = 1 
    LastRow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row 
    Range("B6").Select 
    Selection.AutoFilter 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=2, Criteria1:="<>EHD*" _ 
     , Operator:=xlAnd, Criteria2:="<>ESD*" 
    VisibleCell = Range("A2:I" & LastRow + 1).SpecialCells(xlCellTypeVisible).Cells(1).Row 
    RowsToSelect = VisibleCell.Row 
    Rows(RowsToSelect & ":" & RowsToSelect).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=2 
    Range("F3").Select 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=6, Criteria1:=Array(_ 
     "Missing Audio", "Missing Audio/Subs", "Missing Subs"), Operator:= _ 
     xlFilterValues 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=3, Criteria1:="=DCBU", _ 
     Operator:=xlOr, Criteria2:="=TLBA" 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=7, Criteria1:="=" 
    VisibleCell = Range("A2:I" & LastRow + 1).SpecialCells(xlCellTypeVisible).Cells(1).Row 
    RowsToSelect = VisibleCell.Row 
    Rows(RowsToSelect & ":" & RowsToSelect).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=7 
    Range("H1").Select 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=8, Criteria1:="<>*BGR*" _ 
     , Operator:=xlAnd 
    VisibleCell = Range("A2:I" & LastRow + 1).SpecialCells(xlCellTypeVisible).Cells(1).Row 
    RowsToSelect = VisibleCell.Row 
    Rows(RowsToSelect & ":" & RowsToSelect).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$ & LastRow").AutoFilter Field:=8 
    ActiveSheet.Range("$A$6:$I$ & LastRow").AutoFilter Field:=3 
    ActiveSheet.Range("$A$6:$I$ & LastRow").AutoFilter Field:=7, Criteria1:="POR" 
    VisibleCell = Range("A2:I" & LastRow + 1).SpecialCells(xlCellTypeVisible).Cells(1).Row 
    RowsToSelect = VisibleCell.Row 
    Rows(RowsToSelect & ":" & RowsToSelect).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$ & LastRow").AutoFilter Field:=7 
    ActiveSheet.Range("$A$6:$I$ & LastRow").AutoFilter Field:=6, Criteria1:= _ 
     "Missing Subs" 
    VisibleCell = Range("A2:I" & LastRow + 1).SpecialCells(xlCellTypeVisible).Cells(1).Row 
    RowsToSelect = VisibleCell.Row 
    Rows(RowsToSelect & ":" & RowsToSelect).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=6, Criteria1:= _ 
     "=Missing Audio", Operator:=xlOr, Criteria2:="=Missing Audio/Subs" 
    Range("F2").Select 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=1, Criteria1:= _ 
     "=*Sunrise Earth*", Operator:=xlAnd 
    VisibleCell = Range("A2:I" & LastRow + 1).SpecialCells(xlCellTypeVisible).Cells(1).Row 
    RowsToSelect = VisibleCell.Row 
    Rows(RowsToSelect & ":" & RowsToSelect).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=1 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=7, Criteria1:="ENG" 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=3, Criteria1:=Array(_ 
     "AHPL", "APPL", "CIPO", "DPOL", "IDPL", "SCPO", "TLPO", "WOIT"), Operator:=xlFilterValues 
    VisibleCell = Range("A2:I" & LastRow + 1).SpecialCells(xlCellTypeVisible).Cells(1).Row 
    RowsToSelect = VisibleCell.Row 
    Rows(RowsToSelect & ":" & RowsToSelect).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=3 
    Range("B11").Select 
End Sub

編輯2：

Sub ProgMisr() 
' 
' ProgMisr Macro 
' 
' Keyboard Shortcut: Ctrl+Shift+M 
' 
    Columns("A:A").Select 
    Selection.Delete Shift:=xlToLeft 
    ActiveWindow.ScrollColumn = 2 
    Range("I:I,K:K,L:L").Select 
    Range("L1").Activate 
    Selection.Delete Shift:=xlToLeft 
    ActiveWindow.ScrollColumn = 1 
    LastRow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row 
    Range("B6").Select 
    Selection.AutoFilter 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=2, Criteria1:="<>EHD*" _ 
     , Operator:=xlAnd, Criteria2:="<>ESD*" 
    VisibleCell = Range("A7:I" & LastRow + 1).SpecialCells(xlCellTypeVisible).Cells(1).Row 
    Rows(VisibleCell & ":" & VisibleCell).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=2 
    Range("F3").Select 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=6, Criteria1:=Array(_ 
     "Missing Audio", "Missing Audio/Subs", "Missing Subs"), Operator:= _ 
     xlFilterValues 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=3, Criteria1:="=DCBU", _ 
     Operator:=xlOr, Criteria2:="=TLBA" 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=7, Criteria1:="=" 
    VisibleCell = Range("A7:I" & LastRow + 1).SpecialCells(xlCellTypeVisible).Cells(1).Row 
    Rows(VisibleCell & ":" & VisibleCell).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=7 
    Range("H1").Select 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=8, Criteria1:="<>*BGR*" _ 
     , Operator:=xlAnd 
    VisibleCell = Range("A7:I" & LastRow + 1).SpecialCells(xlCellTypeVisible).Cells(1).Row 
    Rows(VisibleCell & ":" & VisibleCell).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=8 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=3 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=7, Criteria1:="POR" 
    VisibleCell = Range("A7:I" & LastRow + 1).SpecialCells(xlCellTypeVisible).Cells(1).Row 
    Rows(VisibleCell & ":" & VisibleCell).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=7 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=6, Criteria1:= _ 
     "Missing Subs" 
    VisibleCell = Range("A2:I" & LastRow + 1).SpecialCells(xlCellTypeVisible).Cells(1).Row 
    Rows(VisibleCell & ":" & VisibleCell).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=6, Criteria1:= _ 
     "=Missing Audio", Operator:=xlOr, Criteria2:="=Missing Audio/Subs" 
    Range("F2").Select 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=1, Criteria1:= _ 
     "=*Sunrise Earth*", Operator:=xlAnd 
    VisibleCell = Range("A2:I" & LastRow + 1).SpecialCells(xlCellTypeVisible).Cells(1).Row 
    Rows(VisibleCell & ":" & VisibleCell).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=1 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=7, Criteria1:="ENG" 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=3, Criteria1:=Array(_ 
     "AHPL", "APPL", "CIPO", "DPOL", "IDPL", "SCPO", "TLPO", "WOIT"), Operator:=xlFilterValues 
    VisibleCell = Range("A2:I" & LastRow + 1).SpecialCells(xlCellTypeVisible).Cells(1).Row 
    Rows(VisibleCell & ":" & VisibleCell).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter Field:=3 
    Range("B11").Select 
End Sub

來源

2015-04-23 Chris

宏是有點亂所以其種很難理解你想什麼去完成。你能說出你想要刪除/過濾哪些數據嗎？它們是位於表單上的數據，這樣宏就更有意義了。 –

當然，我現在更新我的問題 – Chris

這一切都很順利，你應該參數來篩選數據範圍和範圍的數據被刪除。

而不是使用ActiveSheet.Range("$A$6:$I$5761").AutoFilter或ActiveSheet.Range("$A$6:$I$1412").AutoFilter ...您可以先計算所有數據的最後一行，例如LastRow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row（在使用第一個自動過濾器之前）。現在，您可以replece他們是這樣的： ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter +你的每一個自動篩選

參數使用自動篩選後你匹配所選數據的第一行，並選擇全部：

Rows("7:7").Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Delete Shift:=xlUp

注意，每個自動篩選行號後可能會有所不同。你可以用它來計算第一行：

Set VisibleCell = Range("A6:I" & LastRow + 1).SpecialCells(xlCellTypeVisible).Cells(1) 
RowsToSelect = VisibleCell.Row 
Rows(RowsToSelect & ":" & RowsToSelect).Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Delete Shift:=xlUp

我希望能幫助你解決這個問題。

編輯 - insted的：

Set VisibleCell = Range("A7:I" & LastRow + 1).SpecialCells(xlCellTypeVisible).Cells(1) 
RowsToSelect = VisibleCell.Row 
Rows(RowsToSelect & ":" & RowsToSelect).Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Delete Shift:=xlUp

您可以使用：

VisibleCell = Range("A7:I" & LastRow + 1).SpecialCells(xlCellTypeVisible).Cells(1).Row 
Rows(VisibleCell & ":" & VisibleCell).Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Delete Shift:=xlUp

IST短:)

來源

2015-04-23 11:55:48 Dawid

我已經嘗試了建議的長短方式，但在Set VisibleCell = Range（「A2：I」＆LastRow + 1）.SpecialCells（xlCellTypeVisible）.Cells（1）.Row'階段，準確地說是「不匹配」錯誤。 – Chris

試試這個：'VisibleCell = Range（「A2：I」＆LastRow + 1）.SpecialCells（xlCellTypeVisible）.Cells（1）.Row' in short way there is no「set」 – Dawid

我不應該將它設置爲A7：一世？當行6上設置了過濾器？ – Chris

還是不太明白你在拍什麼，但是你想試試下面的代碼，看看它是否對你有用？

我勸你，以防萬一運行的代碼之前，使表的副本你想做出一些改變。

Sub Delete_Data_Test() 

    'array of which data you want to delete 
    DaleteArray = Array("EHD", "ESD", "DCBU", "TLBA", "BGR", "POR", "Missing Audio", "Missing Audio/Subs", "Missing Subs", "Sunrise Earth", "AHPL", "APPL", "CIPO", "DPOL", "IDPL", "SCPO", "TLPO", "WOIT") 

    'for each individual in the Deleting Array 
    For Each Word In DeleteArray 

     'find word to delete in column A 
     Set findWord = Range("A:A").Find _ 
         (what:=(Word), LookIn:=xlValues) 
     'find the last row in the Worksheet 
     Set findLastrow = Range("A:A").Find _ 
      ("*", After:=Cells(1, 1), SearchDirection:=xlPrevious) 

      'while there is a Word on column A that needs deleting 
      Do While Not findWord Is Nothing 

       'double check the value 
       If Cells(findWord.Row, 1).Value = Word Then 

        'delete entire row that contains the word in column A 
        Row(findWord.Row).Delete Shift:=xlUp 

       Else 
        'find the next time the word appears 
        Set findtext = Range("F" & findWord.Row & ":F" & findLastrow.Row).Find _ 
        (what:=(Word), LookIn:=xlValues) 
       End If 

      Loop 

    Next 

End Sub

檢查一下，看看你是否需要或者是否需要重新調整。

BTW，你應該看看一些these獲得與VBA更熟悉。

來源

2015-04-23 11:53:37

問題是我只想在某些情況下刪除某些單詞。例如，一開始我會刪除任何不以EHD或ESD開始的東西。在此之後，我刪除了行DCBU或TLBA但不包含BUL的行，然後刪除包含DCBU或TLBA和BUL但不包含BGR的行。任何包含Missing Subs的行都將被刪除，並且列A中具有Sunrise Earth的任何行都將被刪除，但隨後只會包含ENG的行再次變得複雜，並且可以刪除這4個字母代碼。 – Chris

@Chris，你可以添加工作表和你的數據看起來像你的問題的截圖嗎？我的印象是，你想要一次性刪除整套可刪除數據，但是這些潛艇可以分成2或3個或者一個用戶表單，所以你一次只能刪除一些特定的數據。 –

過濾掉原始數據報告通過基本的宏

回答

相關問題