Question

我正在尝试删除基于它们的整行，这些行不包含某些标准，这就是我目前所拥有的：

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移动到Infomation（它们在同一个工作簿中）。

Answer 1

我会将测试放在一个单独的函数中以缩短代码。这是我的建议，从中得到你喜欢的东西

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

Answer 2

考虑：

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

Excel 2010：VBA删除不包含特定条件的行

2 个答案: