筛选以 42 和 48 开头的值的列，然后删除行

Question

我正在尝试过滤一列以查找以 42 和 48 开头的值，然后删除行。

出现错误信息

应用程序定义或对象定义错误

Sub FilterDeleteVisible()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("DO") 
    Call FilterAndDelete(ws, "E", "42*", "48*")    
End Sub

Sub FilterAndDelete(ws As Worksheet, col As String, ParamArray criteria() As Variant)
    Dim rng As Range
    Dim MyArray As Variant
    MyArray = criteria
    Set rng = ws.Range(col & ":" & col)
    rng.AutoFilter Field:=1, Criteria1:=MyArray, Operator:=xlFilterValues
    rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    ws.AutoFilterMode = False
End Sub

Answer 1

注：（感谢@MGonet的评论）

• 由于使用了通配符，它仅将文本和数字过滤为文本。也就是说，它不适用于列中的数字。

• Operator:=xlFilterValues

  不支持通配符条件。如果

  xlOr

  中只有两项（带通配符），则转换为

  MyArray

  。

rng.AutoFilter Field:=1, Criteria1:=MyArray(0), Criteria1:=MyArray(1), Operator:=xlOr

---

• rng

  是Column的范围对象。工作表上没有更多空间（单元格）用于

  rng.Offset(1, 0)

  。
• 使用

  End(xlUp)

  获取列上最后使用的单元格
• 在使用偏移之前调整范围大小更可靠。

  rng.Resize(rng.Rows.Count - 1).Offset(1, 0)

• OERN

  用于在过滤后没有任何可见行时忽略错误。

Sub FilterAndDelete(ws As Worksheet, col As String, ParamArray criteria() As Variant)
    Dim rng As Range, lastRow As Long, c As Range
    Dim MyArray As Variant
    MyArray = criteria
    With ws
        If .AutoFilterMode Then .AutoFilter.ShowAllData
        Set rng = .Range(.Cells(1, col), .Cells(.Rows.Count, col).End(xlUp))
    End With
    If UBound(MyArray) = 1 Then
        rng.AutoFilter Field:=1, Criteria1:=MyArray(0), Criteria1:=MyArray(1), Operator:=xlOr
    Else
        ' Doesn't support wildcards if more than 2 items in MyArray
        rng.AutoFilter Field:=1, Criteria1:=MyArray, Operator:=xlFilterValues
    End If
    On Error Resume Next 'OERN for blank
    Set c = rng.Resize(rng.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Not c Is Nothing Then
        c.EntireRow.Delete
    End If
    ws.AutoFilterMode = False
End Sub

微软文档：

声明结束

Range.Resize 属性 (Excel)

Answer 2

使用 Like 运算符按带有通配符的数字进行过滤

• 如果您的列包含数字，

  AutoFilter

  将不起作用。这是一个解决方法，其效率大致与

  Range.Union

  允许的一样高。
• 它也适用于字符串，但我想使用

  AutoFilter

  应该会更快。
• 它还允许您根据需要拥有尽可能多的标准。

用法

Sub FilterDeleteVisible()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("DO")
    FilterWcNumbers ws, "E", "42*", "48*"
End Sub

方法

Sub FilterWcNumbers(ByVal ws As Worksheet, ByVal Col As String, ParamArray Criteria() As Variant)
    
    If ws.FilterMode Then ws.ShowAllData
    
    Dim rg As Range: Set rg = Intersect(ws.UsedRange, ws.Columns(Col))
    If rg Is Nothing Then Exit Sub ' no column
    If rg.Columns.Count > 1 Then Exit Sub ' multiple columns
    
    Dim rCount As Long: rCount = rg.Rows.Count - 1
    If rCount = 0 Then Exit Sub ' no data in column
    
    Set rg = rg.Resize(rCount).Offset(1)
    
    Dim Data() As Variant
    
    If rCount = 1 Then
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
    Else
        Data = rg.Value
    End If
    
    Dim cUpper As Long: cUpper = UBound(Criteria)
    
    Dim urg As Range, r As Long, c As Long
        
    For r = 1 To rCount
        For c = 0 To cUpper
            If CStr(Data(r, 1)) Like Criteria(c) Then
                If urg Is Nothing Then
                    Set urg = rg.Cells(r)
                Else
                    Set urg = Union(urg, rg.Cells(r))
                End If
                Exit For
            End If
        Next c
    Next r
    
    If urg Is Nothing Then Exit Sub ' no matches found
    
    urg.EntireRow.Delete xlShiftUp

End Sub