添加多个条件以搜索列中的特定单词并删除整行

Question

这是下面的代码（由VBasic2008提供），它非常适用于单个值的搜索和删除但是：

1- 我需要添加更多值 (Fired, Leave, 在职, 第三者, Return) 在同一列中。我尝试用逗号、AND 和其他方式添加 other，但无法解决。

2- 我需要在 CE 列中对其他值执行相同的过程（1NotEmployee, 0NotEmployee)。是否可以将这个条件添加到相同的代码中，或者我应该为它创建一个单独的模块？

Sub DeleteResigned()
    
    Dim dt As Double: dt = Timer
    
    Const FirstCriteriaCellAddress As String = "O1"
    Const Criteria As String = "Resigned"

    Application.ScreenUpdating = False

    ' Reference the worksheet and remove any filters.
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    If ws.FilterMode Then ws.ShowAllData
    
    ' Reference the range.
    Dim fCell As Range: Set fCell = ws.Range(FirstCriteriaCellAddress)
    Dim rg As Range: Set rg = fCell.CurrentRegion
    
    ' Calculate the column index.
    Dim cIndex As Long: cIndex = fCell.Column - rg.Column + 1
    
    With rg.Columns(cIndex)
        ' Check if any criteria.
        If Application.CountIf(.Resize(.Rows.Count - 1).Offset(1), Criteria) _
                = 0 Then
            Application.ScreenUpdating = True
            MsgBox "No criteria found", vbExclamation
            Exit Sub
        End If
        ' Insert a helper column containing an ascending integer sequence.
        .Insert xlShiftToRight, xlFormatFromRightOrBelow
        With .Offset(, -1)
            .NumberFormat = 0
            .Value = ws.Evaluate("ROW(" & .Address & ")")
        End With
    End With
    
    ' Sort the range by the criteria column.
    rg.Sort rg.Columns(cIndex + 1), xlAscending, , , , , , xlYes
    
    ' Reference the data range (no headers).
    Dim drg As Range: Set drg = rg.Resize(rg.Rows.Count - 1).Offset(1)
    
    ' Filter the data of the criteria column.
    rg.AutoFilter cIndex + 1, Criteria
    
    ' Reference the visible data rows of the filtered range and delete them.
    Dim vdrg As Range: Set vdrg = drg.SpecialCells(xlCellTypeVisible)
    ws.AutoFilterMode = False
    vdrg.Delete xlShiftUp
    
    ' Sort by and delete the helper column.
    rg.Sort rg.Columns(cIndex), xlAscending, , , , , , xlYes
    rg.Columns(cIndex).Delete xlShiftToLeft
    
    Application.ScreenUpdating = True
    
    Debug.Print Timer - dt

    MsgBox "Rows deleted.", vbInformation
    
End Sub

Answer 1

您应该添加一个 Select case 语句以使其更容易

Dim criteria As String

Select Case True
 Case criteria Like "Resigned", "Fired", "Leave", "Employed", "3rd Party", "Return"
  Your code here
 Case else
  What does it do if it can't find the value..
End Select

对于第二个过程，我会再做一个select子句以避免调试时出现问题。

希望对您有所帮助！

添加多个条件以搜索列中的特定单词并删除整行

Adding multiple criteria to search specific words in a columns and delete entire rows

excel

vba