筛选并删除多个条件

Question

发帖希望我没有被火焰烤焦。坦白说，我是一个新手，尽管我已经尽力了，但罗马不是一天建成的，我陷入了困境。

我在其他地方得到了一些帮助，对这个人表示敬意，他们处于完全不同的时区，我不想轰炸他们。

我将一份报告从 Power BI 提取到 Excel 中。我现在的当前编码是删除底部 3 行，删除 A 列 (1) 中具有重复 PO 编号的行，过滤并删除 J 列 (10) 中除“已批准”之外的所有条目。这已经过测试并且效果很好。

还有数千行需要过滤和删除才能留下我想要的数据，这就是症结所在......

H 列（8）是原始程序中输入名称的地方。当采取行动时，我们会在其前面加上“R”前缀。不幸的是，每个同事似乎都有自己的方法来做到这一点，并且有多个条目需要尝试和完成。将多个 R 前缀方法与许多名称组合在一起并过滤/删除这些前缀条目成为每个人最糟糕的噩梦。还有一些其他前缀，但 R 绝对是我们生活的祸根。数千行。我们要从工作表中删除所有带前缀的条目。

最常见的主题是“R”后跟空格或连字符。下面是我迄今为止发现的内容的捕获，出于明显的原因，这里使用测试文本输入而不是名称（真实数据是为了反映我们想要保留的名称可能以 R 开头的位置，即 Rebecca 和 XX或 * 前缀是我们过滤和删除结果的另一个前缀）：

R - Test Text
R Test Text
R-Test Text
RTest Text
Real Data
R-
R Test Text
R- Test Text
R_Test Text
XX Test Text
*Test Text

带有 RTest 文本的行可能必须手动完成，但所有其他实例是否可以通过 VBA 删除这些行，还是数量太多？

我尝试根据给定的一些信息尝试编码，但结果出现了严重错误，删除了我想要的所有内容，并留下了一些我不想要的条目。请看下面：

Option Explicit
Sub RsRemovalTest()
    Dim ws As Worksheet, LRow As Long
    Set ws = ActiveSheet
    LRow = ws.Cells.Find("*", , xlFormulas, , 1, 2).Row
    
    ws.Cells(LRow, 1).Offset(-2).Resize(3).EntireRow.Delete
    If ws.AutoFilterMode Then ws.AutoFilter.ShowAllData
    With ws.Range("A1").CurrentRegion
        .RemoveDuplicates Columns:=1, Header:=xlYes
        .AutoFilter 10, "<>Approved"
        If .SpecialCells(xlCellTypeVisible).Address <> .Rows(1).Address Then
            .Offset(1).EntireRow.Delete
        End If
        .AutoFilter 8, "R *", 2, "R-*", 3, "XX*"
        If .SpecialCells(xlCellTypeVisible).Address <> .Rows(1).Address Then
            .Offset(1).EntireRow.Delete
        End If
        .AutoFilter
    End With
    
End Sub

我会非常感激您的帮助，但如果新手不允许提问，我理解并感谢任何花时间阅读的人。

尝试在网上搜索信息，但我不知道我把东西放在哪里以及如何纠正被删除的错误信息。

Answer 1

您需要高级过滤器才能使用多个条件。

看这里：如何在 Excel 中过滤多个条件？

如果您希望每次更改条件时自动触发过滤器，请使用此宏（将其放入工作表对象模块中）：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A2:I5")) Is Nothing Then 'change range with filter criteria
        On Error Resume Next
        ActiveSheet.ShowAllData
        Range("A7").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1").CurrentRegion 'A7 is the first cell of filtered range, A1 is the first cell of range with criteria
    End If
End Sub

Answer 2

请也尝试下一种方法，使用辅助列。它使用数组来加快处理速度：

Sub FilterMultipleCriteria()
  Dim ws As Worksheet, lastR As Long, lastEmptyCol As Long, hlpCell As Range
  Dim arr, arrH, i As Long, boolFound As Boolean
  Const helpCol As String = "Helper" 'the helper column header
  
  Set ws = ActiveSheet 'use the necessary one
  If ws.AutoFilterMode Then ws.AutoFilter.ShowAllData
  
  lastR = ws.Range("H" & ws.rows.count).End(xlUp).row 'last row on H:H
  lastEmptyCol = ws.cells(1, ws.Columns.count).End(xlToLeft).column + 1 'last empty column
  
  arr = ws.Range("H2:H" & lastR).Value2 'place the range in an array for faster iteration
  ReDim arrH(1 To UBound(arr), 1 To 1)  'redim the helper array
  
  'process arr and issue the helper array:
  For i = 1 To UBound(arr)
    Select Case left(arr(i, 1), 2)
        Case "R ", "R-", "R_"
            arrH(i, 1) = "Del": boolFound = True
    End Select
    If Not boolFound Then
        If left(arr(i, 1), 5) = "RTest" Then
            arrH(i, 1) = "Del": boolFound = True
        End If
    End If
    If Not boolFound Then
        If arr(i, 1) = "Real Data" Then
            arrH(i, 1) = "Del": boolFound = True
        End If
    End If
    If Not boolFound Then
        If left(arr(i, 1), 5) = "*Test" Then
            arrH(i, 1) = "Del": boolFound = True
        End If
    End If
    boolFound = False
  Next i
  
  'set the helper column header
  Set hlpCell = ws.cells(1, lastEmptyCol)
    
    With hlpCell
        .value = helpCol 'place the header
        .offset(1).Resize(UBound(arrH), 1).Value2 = arrH 'drop the array content
    End With
  
  'filter by helper column:
  hlpCell.AutoFilter hlpCell.column, "Del"
  
  Dim rngVis As Range 'visible cells range
  On Error Resume Next
   Set rngVis = ws.Range("H2:H" & lastR).SpecialCells(xlCellTypeVisible)
  On Error GoTo 0
  If Not rngVis Is Nothing Then
    rngVis.EntireRow.Delete    'delete the marked rows
    ws.AutoFilterMode = False  'remove the filter
    hlpCell.EntireColumn.Clear 'clear the helper column
  End If
End Sub