通过基本宏过滤掉原始数据报告

Question

我正在尝试在处理原始数据报告时，每天都要进行精心的过滤和删除，并尽可能减少单击按钮。

我相信我通过一个简单的录制宏（见下文）完成了大部分工作，但有时会留下我想要删除的项目的某些条目。查看代码我相信这可能是因为宏正在应用过滤器，它在尝试删除内容时所寻找的起始行不是固定的。所以我的问题是，我应该根据当前持有过滤器的行使用偏移值吗？或者这不会起作用吗？

当我删除标准“POR”“＆lt;＆gt; BGR”和“= Sunrise Earth”时出现问题我认为这是因为遵循这些命令的select函数有一个可能不是的行号永远是真的

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

Answer 1

仍然不太明白你拍的是什么，但你想尝试下面的代码，看看它是否适合你？

我建议你在运行代码之前复制一下表格，以防你想做一些改动。

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

检查一下，看看这是否是你需要的东西，或者是否需要重新进行跳汰。

顺便说一句，你应该看看these的某些内容，以便更熟悉VBA。

Answer 2

一切顺利，您应该参数化以过滤要删除的数据范围和数据范围。

您可以先计算所有数据的最后一行，例如ActiveSheet.Range("$A$6:$I$5761").AutoFilter（在使用第一个AutoFilter之前），而不是使用ActiveSheet.Range("$A$6:$I$1412").AutoFilter或LastRow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row ...现在你可以补充这样的东西： ActiveSheet.Range("$A$6:$I$" & LastRow).AutoFilter +每个AutoFilter的参数

使用自动筛选后，您匹配所选数据的第一行并选择所有数据：

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

请注意，每个AutoFilter行号后可能会有所不同。您可以使用它来计算第一行：

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

我希望这会帮助你解决问题。

编辑 - 输入：

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

我更短：）