自动过滤数组仅按数组中的最后一个条件过滤

Question

我正在尝试通过删除第 9 列中的单元格不以 S、X 或 P 开头的行来对表进行排序。下面是我的代码，用于过滤不符合我的条件的行，然后删除它们，然后显示剩余的值。

Range("I:I").NumberFormat = "@"

    lo.Range.AutoFilter Field:=9, Criteria1:=Array("<>S*", "<>X*", "<>P*"), Operator:=xlOr
   
    Application.DisplayAlerts = False
     lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True
    
    lo.AutoFilter.ShowAllData

目前，无论顺序如何，仅保留包含数组中最后一个条件的行。

Answer 1

删除 Excel 表格的多条件行

• 您不能有两个以上带有通配符的条件（元素）。
• 作为解决方法，此解决方案添加一个新列并向其中写入一个公式。该公式返回一个布尔值，指示字符串是否以列表中的字符开头。然后，它按

  False

  过滤新列，并删除这些过滤后的 tables' （不是工作表的）行。最后，它删除新列。
• 右侧的数据（假设有一个空列）保持不变，不会以任何方式移动，因此插入和删除 worksheet 列而不是使用

  .ListColumns.Add

  。
• 调整常量部分中的值。

Option Explicit

Sub DeleteMultiCriteriaRows()
    
    Const wsName As String = "Sheet1"
    Const tblName As String = "Table1"
    Const NotFirstCharList As String = "s,x,p"
    Const CritCol As Long = 9
    
    ' Extract chars for the formula.
    Dim Nfc() As String: Nfc = Split(NotFirstCharList, ",")
    Dim NotFirstChar As String: NotFirstChar = "{"
    Dim n As Long
    For n = 0 To UBound(Nfc)
        NotFirstChar = NotFirstChar & """" & Nfc(n) & ""","
    Next n
    NotFirstChar = Left(NotFirstChar, Len(NotFirstChar) - 1) & "}"
    Erase Nfc
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim tbl As ListObject: Set tbl = ws.ListObjects(tblName)
    
    Application.ScreenUpdating = False
    
    With tbl
        
        If Not .ShowAutoFilter Then .ShowAutoFilter = True
        If .AutoFilter.FilterMode Then .AutoFilter.ShowAllData ' remove filter
        
        .ListColumns(CritCol).DataBodyRange.NumberFormat = "@" ' ?
        
        Dim nFormula As String
        nFormula = "=ISNUMBER(MATCH(LEFT(" & .Name & "[@" _
            & .ListColumns(CritCol).Name & "],1)," & NotFirstChar & ",0))"
        
        Dim LastCol As Long: LastCol = .ListColumns.Count
        With .ListColumns(1) ' write formulas to newly inserted column
            .Range.Offset(, LastCol).EntireColumn.Insert
            .DataBodyRange.Offset(, LastCol).Formula = nFormula
        End With
        
        LastCol = LastCol + 1 ' think new column
        .Range.AutoFilter LastCol, False ' think Not(FirstChar)
        
        Dim vrg As Range ' Visible Range
        On Error Resume Next ' prevent 'No cells found...' error
            Set vrg = .DataBodyRange.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        
        .AutoFilter.ShowAllData  ' remove filter
        
        If Not vrg Is Nothing Then ' delete visible rows
            vrg.Delete Shift:=xlShiftUp
        End If
        
        .ListColumns(LastCol).Range.EntireColumn.Delete ' delete new column
    
    End With
    
    Application.ScreenUpdating = True
    
End Sub

Answer 2

此代码将删除工作簿中第一张工作表的第一个表的第 9 列中具有值且不以

arrBeginsWith

中的字母开头的所有行。

还有其他方法可以实现您想要的目的，例如添加一个辅助列，用于标识要使用公式删除的行，然后对该列进行过滤。

Option Explicit

Sub KeepRowsStartingWith()
Dim tbl As ListObject
Dim rngDelete As Range
Dim arrBeginsWith As Variant
Dim arrData As Variant
Dim idxRow As Long
Dim StartRow As Long
Dim Res As Variant

    Set tbl = Sheets(1).ListObjects(1)
    
    With tbl.ListColumns(9).DataBodyRange
        StartRow = .Cells(1, 1).Row
        arrData = .Value
    End With
    
    ReDim arrDeleteRows(1 To UBound(arrData, 1))
    
    arrBeginsWith = Array("S", "X", "P")
    
    For idxRow = 1 To UBound(arrData, 1)
    
        Res = Application.Match(Left(arrData(idxRow, 1), 1), arrBeginsWith, 0)
        
        If IsError(Res) Then
            If rngDelete Is Nothing Then
                Set rngDelete = Intersect(tbl.DataBodyRange, Sheets(1).Rows(idxRow + StartRow - 1))
            Else
                Set rngDelete = Union(rngDelete, Intersect(tbl.DataBodyRange, Sheets(1).Rows(idxRow + StartRow - 1)))
            End If
        End If
        
    Next idxRow

    rngDelete.Delete xlShiftUp
    
End Sub

Answer 3

我最终在表格中创建了一个新列，其中使用 if 语句来识别单元格是否以字母或数字开头。然后，我筛选出具有数字的行，删除这些行，然后显示剩余的行。然后我删除了辅助列，以便以后不必处理它。

ThisWorkbook.Worksheets("Aluminum Futures").Columns("T:T").Select
Selection.Insert Shift:=xlToRight
Range("T1") = "Letter/Number"


    Range("T2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISERR(LEFT(RC[-11],1)*1),""letter"",""number"")"
    Range("T2").Select
    Selection.AutoFill Destination:=Range("PF[Letter/Number]")
    Range("PF[Letter/Number]").Select
    
    
    lo.Range.AutoFilter Field:=20, Criteria1:="number"
    
    Application.DisplayAlerts = False
       lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True
    
    lo.AutoFilter.ShowAllData
    
    Columns("T:T").Delete