Question

我还是VBA的新手。这是一篇新文章，因为我在上一篇文章中不够具体。
我的目标：我想根据另一张工作表中的一列数据删除我的数据行。

我有一张数据名称：WorkingData。
WorkingData是列A下的ProductIDs数据库列表 productIDs将不止一次存在，因为它是用句点标识的。

ProductIDs    Date
132           30/9/2018
132           30/8/2018
132           30/7/2018
122           30/9/2018
122           30/8/2018
11            30/7/2018
11            30/6/2018
...

Sheets（要排除的ID）

ProductID
11
23
55
34
.....

我有一个外部工作表名称：IDs to exclude。
在Sheets("IDs to exclude")的A列下，有一个ID列表要排除，因为它们是不干净的数据。但是，每个月列表都会不断添加，因此范围必须标识最后一行。

这是我的代码，但我只能逐行执行。有成千上万的数据输入。请告知谢谢！

Sub delete_Ids()
    Dim c As Range, MyVals As Range, SrchRng As Range
    Dim i As Long, lr1 As Long, lr2 As Long, x

    'This is a range containing all the criteria to search for
    lr1 = Sheets("WorkingData").Cells(Rows.Count, "A").End(xlUp).Row
    Set MyVals = Sheets("ProductIDs to Exclude").Range("A2:A" & lr1)

    Set SrchRng = Selection
    lr2 = SrchRng.Rows.Count

    For i = lr2 To 1 Step -1
        For Each c In MyVals
    x = InStr(SrchRng(i), c)

    If x > 0 Then
                SrchRng(i).EntireRow.Delete
                Exit For
            End If
        Next c
    Next i  
End Sub

Answer 1

为了使您的代码更快：

将数据（列A）读入数组ArrIDs
读取ID以渗入数组ArrExclude
遍历数据ArrIDs和
使用WorksheetFunction.Match方法检查它是否与要排除的任何ID匹配。
将所有匹配的行收集到变量RowsToDelete
最后一次删除它们。

这将是我认为最快的方法之一。

问题在于，对单元的每次读/写操作都需要花费很多时间，因此我们尝试减少它们。如果您自行删除每一行，那么您会有很多写操作。但是，如果您首先使用Union收集它们并立即删除它们，则只有一个写入操作。

读取单元格值也是如此。如果我们每次需要比较一个值时，将其减少到数组中的一个读取动作，而不是多个读取动作，那么它将更快。

Option Explicit

Public Sub AlternativeDeleteIDs()
    Dim wsData As Worksheet 'define datat sheet
    Set wsData = ThisWorkbook.Worksheets("WorkingData")

    Dim ArrIDs() As Variant 'read data into array
    ArrIDs = wsData.Range("A1", wsData.Cells(wsData.Rows.Count, "A").End(xlUp)).Value

    Dim ArrExclude() As Variant 'read IDs to exclude into array
    With ThisWorkbook.Worksheets("IDs to exclude")
        ArrExclude = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).Value
    End With

    Dim RowsToDelete As Range 'we collect all rows to delete here
    Dim MatchedRow As Long

    Dim iRow As Long
    For iRow = LBound(ArrIDs, 1) + 1 To UBound(ArrIDs, 1) '+1 because of header in data
        MatchedRow = 0 'initialize
        On Error Resume Next 'next line throws error if ID is not in exclude list
        MatchedRow = Application.WorksheetFunction.Match(ArrIDs(iRow, 1), ArrExclude, False)
        On Error GoTo 0

        If MatchedRow <> 0 Then 'ID was found in exclude list
            'mark ID for delete
            If RowsToDelete Is Nothing Then
                Set RowsToDelete = wsData.Rows(iRow)
            Else
                Set RowsToDelete = Union(RowsToDelete, wsData.Rows(iRow))
            End If
        End If
    Next iRow

    'delete all rows at once
    RowsToDelete.Delete
End Sub

所以在这段代码中，我们只有2个读取动作（进入数组）和1个写入动作（删除）。

根据不同工作表下一列中的多个单元格值删除行

1 个答案: