Question

在包含大约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

这个宏需要花费很多时间，而且似乎最多有＆＃39; and-statements＆＃39;。

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

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

我已经尝试通过https://www.rondebruin.nl/win/winfiles/MoreDeleteCode.txt上的标准范围<另一张* 来解决这个问题，但我并不完全理解这个VBA代码。

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

Answer 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

Answer 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

如果范围中未提及值，则删除行

2 个答案: