excel - 根据另一个 excel 文件中的值删除 excel 文件中记录的最快方法

Question

我需要以下方面的指导。我有一个包含 150000 条记录的文件 (excel)。收到另一个包含 5000-6000 条记录的 excel 文件，需要根据第二个文件中信息的某些条件删除该行。

我使用字典函数收集字典中的第二个文件数据-

IntI = 2
Do While wbk.Sheets("Sheet1").Cells(IntI, 1).Value <> ""
    strAgNo = wbk.Sheets("Sheet1").Cells(IntI, 8).Value
    If Dict.Exists(strAgNo) Then
    Else
        Dict.Add Key:=strAgNo, Item:=IntI
    End If
    IntI = IntI + 1
Loop
wbk.Close SaveChanges:=False

然后根据第二个文件记录的标准，使用Range Find命令(rgFound is Object)对第一个文件进行序列化-

For n = 0 To Dict.Count - 1
    strAgNo = Dict.Keys(n)
    Set rgFound = Range("G:G").Find(strAgNo)
    If rgFound Is Nothing Then
        intNotSetlAg = intNotSetlAg + 1
    Else
        FoundRow = rgFound.Row
        intSetlAg = intSetlAg + 1
        Rows(FoundRow).Select
        wbk.Sheets("Details").Rows(FoundRow).Delete
    End If
Next n

这工作正常。但是，对于第一个文件中的 160000 到 180000 条记录和 5 到 6K 行(要在第一个文件中删除)，需要 40-45 分钟。在 excel vba 中需要这方面的指导。

Answer 1

根据我上面的评论。这对我来说用了大约 20 秒(150k 行数据，要删除的 5k 个随机值)

编辑:重构了一下......

Sub DeleteMatches()
    
    Dim dict As Object, arr, n As Long, t
    Dim col As New Collection
    
    'create some sample data
    With Sheet1.[A2:A150000]
        .Formula = "=""Val_"" & TEXT(ROW()-1,""00000000"")"
        .Value = .Value
    End With
    
    t = Timer
    
    'load the ids to be deleted
    'tested with 5k rows of `="Val_" & TEXT(RANDBETWEEN(1,150000),"00000000")`
    Set dict = UniquesFromColumn(Sheet2.Range("A2"))
    Debug.Print "Loaded Ids: " & Timer - t
    
    'load the sheet1 id column into an array and scan through it,
    '  collecting any matched rows in the Collection
    arr = Sheet1.Range("A1", Sheet1.Cells(Rows.Count, 1).End(xlUp)).Value
    For n = 2 To UBound(arr, 1) 'skip header row if present
        If dict.exists(arr(n, 1)) Then col.Add Sheet1.Cells(n, 1)
    Next n
    Debug.Print "Scanned sheet1 for matches: " & Timer - t
    
    DeleteRows col 'delete the collected rows
    Debug.Print "Deleted " & col.Count & " rows: " & Timer - t
        
End Sub

'return a dictionary of unique values from a column, starting at `startCell`
Function UniquesFromColumn(startCell As Range) As Object
    Dim dict As Object, arr, n As Long, v
    Set dict = CreateObject("scripting.dictionary")
    With startCell.Parent
        arr = .Range(startCell, _
                     .Cells(.Rows.Count, startCell.Column).End(xlUp)).Value
    End With
    For n = 1 To UBound(arr)
        v = arr(n, 1)
        If Len(v) > 0 Then dict(v) = dict(v) + 1
    Next n
    Set UniquesFromColumn = dict
End Function

'delete all rows based on a collection of cells
Sub DeleteRows(col As Collection)
    Dim rng As Range, n As Long, i As Long
    If col.Count = 0 Then Exit Sub
    'loop over the cells in the collection, building ranges for deletion
    For n = col.Count To 1 Step -1
        If rng Is Nothing Then
            Set rng = col(n)
            i = 1
        Else
            Set rng = Application.Union(rng, col(n))
            i = i + 1
            If i > 200 Then 'union gets slow after a point, so delete and reset
                rng.EntireRow.Delete
                Set rng = Nothing
            End If
        End If
    Next n
    If Not rng Is Nothing Then rng.EntireRow.Delete 'any last rows?
End Sub