如果范围内未提及值，则删除行答案

【问题标题】：Delete rows if value is not mentioned in range如果范围内未提及值，则删除行
【发布时间】：2017-10-18 13:02:25
【问题描述】：

在大约 50.000 行的文件中，我想删除 B 列中没有特定数字的行。我使用以下代码：

Sub DelRows()

Application.ScreenUpdating = False

Worksheets("2016").Activate

lastrow = Cells(Rows.Count, "A").End(xlUp).Row

For i = lastrow To 2 Step -1
If Cells(i, "B").Value <> "1060" And _
Cells(i, "B").Value <> "1061" And _
Cells(i, "B").Value <> "1062" And _
Cells(i, "B").Value <> "1063" And _
Cells(i, "B").Value <> "1064" And _
Cells(i, "B").Value <> "1105" And _
Cells(i, "B").Value <> "11050" And _
Cells(i, "B").Value <> "11051" And _
Cells(i, "B").Value <> "11053" And _
Cells(i, "B").Value <> "11054" And _
Cells(i, "B").Value <> "1160" And _
Cells(i, "B").Value <> "1161" And _
Cells(i, "B").Value <> "1162" And _
Cells(i, "B").Value <> "1163" And _
Cells(i, "B").Value <> "1164" And _
Cells(i, "B").Value <> "1166" And _
Cells(i, "B").Value <> "1168" And _
Cells(i, "B").Value <> "1169" And _
Cells(i, "B").Value <> "8060" And _
Cells(i, "B").Value <> "8061" And _
Cells(i, "B").Value <> "8062" And _
Cells(i, "B").Value <> "8063" And _
Cells(i, "B").Value <> "8064" And _
Cells(i, "B").Value <> "8068" And _
Cells(i, "B").Value <> "8192" Then
Cells(i, "B").EntireRow.Delete
End If

Next i

End Sub

这个宏需要很多时间，而且似乎有最多的'and-statements'。

我尝试使用数组或过滤器来解决这个问题，但对于初学者来说这很难。

我想将数字作为范围放在单独的工作表上，例如：

我试图通过https://www.rondebruin.nl/win/winfiles/MoreDeleteCode.txt 上的 Criteria range on a different sheet* 部分来解决这个问题，但我并不完全理解这个 VBA 代码。

有人可以帮帮我吗？亲切的问候，理查德

【问题讨论】：

您是否尝试过实现该代码？你有多少列数据？
要优化，请尝试使用带有数组多条件的自动过滤器并删除单个任务上的行。或者，如果您不想使用过滤器，您可以创建一个不连续的范围并在以后一次全部删除。因为代码中最耗时的操作是每次在工作表上执行操作时，在您删除的情况下。并参考this、this和this。

标签： vba excel

【解决方案1】：

假设这些值在下面的代码中 - rngCheck 和 rngDelete。

嵌套循环完全可以完成这项工作。外部循环通过范围，应该删除rngDelete，内部循环通过检查值rngCheck。

如果找到匹配的值，则将其删除并退出内部循环。就我们循环遍历行并需要删除其中一些行而言，for 循环是反向计数的：

Option Explicit

Public Sub TestMe()

    Dim cnt         As Long
    Dim rngDelete   As Range
    Dim rngCheck    As Range
    Dim rngCell     As Range

    Set rngCheck = Worksheets(2).Range("A1:A2")
    Set rngDelete = Worksheets(1).Range("A1:A20")

    For cnt = rngDelete.Rows.Count To 1 Step -1
        For Each rngCell In rngCheck
            If rngCell = rngDelete.Cells(cnt, 1) Then
                rngDelete.Rows(cnt).Delete
                Exit For
            End If
        Next rngCell
    Next cnt

End Sub

【讨论】：

【解决方案2】：

这是一种数组方法，可以节省读取和写入电子表格的时间，因此应该更快一些。此方法包括匹配的单元格，而不是排除不匹配的单元格。相应地调整您要检查的单元格范围。我假设您的数据从 2016 年工作表的 A1 开始。

Sub DelRows()

Dim v, i As Long, j As Long, vOut(), k As Long, rExcl As Range

Set rExcl = Sheets("Sheet2").Range("A1:A5") 'adjust accordingly

With Worksheets("2016")
    v = .Range("A1").CurrentRegion.Value
    .Range("A1").CurrentRegion.Offset(1).ClearContents
    ReDim vOut(1 To UBound(v, 1), 1 To UBound(v, 2))
    For i = LBound(v, 1) To UBound(v, 1)
        If IsNumeric(Application.Match(v(i, 2), rExcl, 0)) Then
            j = j + 1
            For k = LBound(v, 2) To UBound(v, 2)
                vOut(j, k) = v(i, k)
            Next k
        End If
    Next i
    .Range("A2").Resize(j, UBound(v, 2)) = vOut
End With

End Sub

【讨论】：