Excel 2010: VB删除不包含特定条件的行



我试图删除基于它们不包含特定标准的整个行,这是我目前拥有的:

Sub Delete_consultants()
  Last = Cells(Rows.Count, "H").End(xlUp).Row
   For i = Last To 1 Step -1
    If (Cells(i, "H").Value) = "Faith Jones" Then
        Cells(i, "A").EntireRow.Delete
    End If
    If (Cells(i, "H").Value) = "Cathy Robbs" Then
        Cells(i, "A").EntireRow.Delete
    End If
    If (Cells(i, "H").Value) = "Nick farmer" Then
        Cells(i, "A").EntireRow.Delete
    End If
     If (Cells(i, "H").Value) = "Jane Till" Then
        Cells(i, "A").EntireRow.Delete
    End If
     If (Cells(i, "H").Value) = "Jack White" Then
        Cells(i, "A").EntireRow.Delete
    End If
     If (Cells(i, "H").Value) = "Dylan Smith" Then
        Cells(i, "A").EntireRow.Delete
    End If
     If (Cells(i, "H").Value) = "Emma Long" Then
        Cells(i, "A").EntireRow.Delete
    End If
     If (Cells(i, "H").Value) = "Nick Winter" Then
        Cells(i, "A").EntireRow.Delete
    End If
     If (Cells(i, "H").Value) = "Niel West" Then
        Cells(i, "A").EntireRow.Delete
    End If
Next i
End Sub

问题是当前正在删除我想要保留的人。但是我不知道如何删除我发现的所有帖子只有1或2个标准,你可以设置我需要9个!!如果可能的话,我似乎无法解决这个问题,如果包含这些名称的行从DirectLink移动到信息(它们在同一工作簿中)。

我会将测试放在一个单独的函数中以缩短代码。这是我的建议,你喜欢什么就拿什么吧

Function IsMember(v As Variant, vArray As Variant) As Boolean
    Dim vLoop As Variant
    For Each vLoop In vArray
        If v = vLoop Then
            IsMember = True
            Exit Function
        End If
    Next vLoop
End Function
Sub Delete_Consultants()
    Dim lLast As Long, i As Long
    Dim vConsultants As Variant
    lLast = Cells(Rows.Count, "H").End(xlUp).Row
    vConsultants = Array("Faith Jones", "Cathy Robbs", "Nick Farmer", "Jane Till", _
        "Jack White", "Dylan Smith", "Emma Long", "Nick Winter", "Niel West")
    For i = lLast To 1 Step -1
        If IsMember(Cells(i, "H"), vConsultants) Then
        'if you want to do something with the others use this instead
        'If Not IsMember(Cells(i, "H"), vConsultants) Then
            Cells(i, "A").EntireRow.Delete
            'or to copy
            'Cells(i, "A").EntireRow.Copy Sheets("Information").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next i
End Sub

考虑:

Sub Delete_consultants()
  Last = Cells(Rows.Count, "H").End(xlUp).Row
  Dim v As Variant
   For i = Last To 1 Step -1
    v = Cells(i, "H").Value
    With Cells(i, "H")
    If v = "Faith Jones" Then
        .EntireRow.Delete
        GoTo botttom
    End If
    If v = "Cathy Robbs" Then
        .EntireRow.Delete
        GoTo botttom
    End If
    If v = "Nick farmer" Then
        .EntireRow.Delete
        GoTo botttom
    End If
     If v = "Jane Till" Then
        .EntireRow.Delete
        GoTo botttom
    End If
     If v = "Jack White" Then
        .EntireRow.Delete
        GoTo botttom
    End If
     If v = "Dylan Smith" Then
        .EntireRow.Delete
        GoTo botttom
    End If
     If v = "Emma Long" Then
        .EntireRow.Delete
        GoTo botttom
    End If
     If v = "Nick Winter" Then
        .EntireRow.Delete
        GoTo botttom
    End If
     If v = "Niel West" Then
        .EntireRow.Delete
        GoTo botttom
    End If
botttom:
    End With
Next i
End Sub

最新更新