僅自動過濾陣列按陣列中的最后一個條件過濾

我試圖通過洗掉第 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

目前，無論順序或順序，只保留包含陣列中最后一個條件的行。

uj5u.com熱心網友回復：

洗掉 Excel 表格的多條件行

• 不能有兩個以上帶有通配符的條件（元素）。
• 作為一種解決方法，此解決方案添加了一個新列并向其寫入一個公式。該公式回傳一個布林值，指示字串是否以串列中的字符開頭。然后它過濾新列False并洗掉這些過濾表的（不是作業表的）行。最后，它洗掉新列。
• 右側的資料（假設為一個空列）保持不變，不會以任何方式移動，因此插入和洗掉作業表列而不是使用.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
        
        .ShowAutoFilter = False ' remove filter (but also arrows)
        
        .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
        
        .Range.AutoFilter ' remove filter (toggle arrows)
        
        If Not vrg Is Nothing Then ' delete visible rows
            vrg.Delete Shift:=xlShiftUp
        End If
        
        .ListColumns(LastCol).Range.EntireColumn.Delete ' delete new column
        .ShowAutoFilter = True ' show arrows
    
    End With
    
    Application.ScreenUpdating = True
    
End Sub

uj5u.com熱心網友回復：

此代碼將洗掉作業簿中第一個表格的第 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

標籤：擅长 vba

上一篇：根據串列打開作業簿并運行特定的宏

下一篇：如何在Excel中為一系列值添加條件格式