VBA删除Excel中不包含特定值的行

我有一本20页的工作簿。每张纸上大约有30000行带有URL。我有一手大约10个不同的网址，我需要保持数据的网址。如果第一列a-URL不包含某个URL，是否有方法删除所有工作表中的所有行

我有以下vba，但它会删除所有行。如果值与下面的代码匹配，我需要保留该行。此外，它在结束时抛出424错误，并删除所有行。有什么想法吗？任何方法都可以只查看列A，而不是放置单元格范围，因为它在每个工作表之间都会变化

Sub DeleteCells()

    Dim rng As Range, i As Integer

    'Set the range to evaluate to range.
    Set rng = Range("A1:A10000")

    'Loop backwards through the rows
    'in the range that you want to evaluate.
    For i = rng.Rows.Count To 1 Step -1

        'If cell i in the range DOES NOT contains an "x", delete the entire row.
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ip/hse" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ip/hse/qhseprivate" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/crp/qhse" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/crp/qhse/csa" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ops/ehqhse" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ops/hsehw" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ops/lahse" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/sites/coloproposal/HSEQ AND GENERAL DOCUMENTS" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/sites/coloproposal/HSEQ AND GENERAL DOCUMENTS/LA OPERATIONS MEETING APRIL 2012" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/crp/hse" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/crp/hse/CorpQHSE" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/crp/hse/IP" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/mfg/mfg/HSE" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/mfg/mfg/HSET" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ops/na/HSE" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ops/na/HSE/er" Then rng.Cells(i).EntireRow.Delete      
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ops/na/HSE/GCR" Then rng.Cells(i).EntireRow.Delete     
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ops/na/HSE/wr" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ops/mexopex" Then rng.Cells(i).EntireRow.Delete        
    Next

End Sub

---

尝试此操作以创建和填充新图纸。你必须添加你自己的代码，把它放在你想要的地方

Sub saveImportantData()
    Dim myUrlArray, oldSheetRowArray, arrayCounter As Long
    Dim tempWS As Worksheet, myWS As Worksheet, newSheetRowCounter As Long

    ReDim oldSheetRowArray(1 To 1)
    Set myWS = ActiveSheet
    Set tempWS = Sheets.Add(After:=Sheets(Worksheets.Count))

    newSheetRowCounter = 1
    arrayCounter = 1
    myUrlArray = Array("https://inside.nov.pvt/ip/hse", _
                    "https://inside.nov.pvt/ip/hse/qhseprivate", _
                    "https://inside.nov.pvt/crp/qhse", _
                    "https://inside.nov.pvt/crp/qhse/csa", _
                    "https://inside.nov.pvt/crp/qhse/csa", _
                    "https://inside.nov.pvt/ops/ehqhse", _
                    "https://inside.nov.pvt/ops/hsehw", _
                    "https://inside.nov.pvt/ops/lahse", _
                    "https://inside.nov.pvt/sites/coloproposal/HSEQ AND GENERAL DOCUMENTS", _
                    "https://inside.nov.pvt/sites/coloproposal/HSEQ AND GENERAL DOCUMENTS/LA OPERATIONS MEETING APRIL 2012", _
                    "https://inside.nov.pvt/crp/hse", _
                    "https://inside.nov.pvt/crp/hse/CorpQHSE", _
                    "https://inside.nov.pvt/crp/hse/IP", _
                    "https://inside.nov.pvt/mfg/mfg/HSE", _
                    "https://inside.nov.pvt/mfg/mfg/HSET", _
                    "https://inside.nov.pvt/ops/na/HSE", _
                    "https://inside.nov.pvt/ops/na/HSE/er", _
                    "https://inside.nov.pvt/ops/na/HSE/GCR", _
                    "https://inside.nov.pvt/ops/na/HSE/wr", _
                    "https://inside.nov.pvt/ops/mexopex")

    For i = 1 To UBound(myUrlArray)
       With myWS.Range("A1:A10000")
        Set c = .Find(myUrlArray(i), LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    oldSheetRowArray(arrayCounter) = c.Row
                    arrayCounter = arrayCounter + 1
                    ReDim Preserve oldSheetRowArray(1 To arrayCounter)
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
    Next i


    Application.ScreenUpdating = False
    For k = 1 To UBound(oldSheetRowArray)
        If oldSheetRowArray(k) <> "" Then
            myWS.Activate
            myWS.Rows(oldSheetRowArray(k) & ":" & oldSheetRowArray(k)).Select
            Selection.Copy
            tempWS.Activate
            tempWS.Range("A" & newSheetRowCounter).Select
            ActiveSheet.Paste
            newSheetRowCounter = newSheetRowCounter + 1
        End If
    Next k
    Application.ScreenUpdating = True

    Set myWS = Nothing
    Set tempWS = Nothing
    Set c = Nothing

End Sub

---

使用if语句时，除了一个之外，其他所有语句都将在每个循环中返回true，从而删除该行。如果使用和检查rng.Cellsi.Value，则需要一个https://inside.nov.pvt/ip/hse 和rng.Cellsi.Valuehttps://inside.nov.pvt/ip/hse/qhseprivate 还有…谢谢Scott的快速回复。您正在删除除第一个命令之外的所有内容。然后用第二个命令删除所有其他内容。将所有要保留的URL放入一个数组中。在所有需要的URL上查找，并将它们的行号放入第二个数组。创建第二个临时工作表，然后向下将该数组中的每一行按1复制到新工作表中。然后清除主工作表，并将数据从新工作表复制回旧工作表。然后干掉新的工作表。嗨，约翰，好主意。有样品吗？我很感激。我不能发布我的答案，但你可以用你的完整URL构建一个数组，然后检查你的行值是否在数组中。我几乎在网上发布了一个答案库。只需为工作表添加一个额外的循环，并将Rowcell.Row.Style=Accent1替换为rng.Cellsi.EntireRow.Delete。当然还有你的URL的果实…非常感谢你的代码。我会试试看，然后告诉你。我很感激，很好用。它创建了一个新的工作表，然后我只需要复制标题的第1行，并删除旧的工作表。谢谢你，约翰。