如何快速搜索并在找到目标行后执行更新/删除操作

嘿，我看你现在的代码用了嵌套循环来找重复项，这种方法在数据量小的时候还行，但数据一多就会特别慢——毕竟每一行都要和之前所有行对比，时间复杂度是O(n²)。咱们换个思路，用Scripting.Dictionary来做快速查找，它的查找操作是O(1)的，效率能提升一大截！

一、快速删除重复项的优化代码 #

这里我们用字典存储已经出现过的第10列（J列）的值，遍历每一行时直接查字典，不用再循环之前的所有行：

Sub DeleteProjectDuplicate()
    Dim BaseWorkbook As Workbook
    Dim ws As Worksheet
    Dim dict As Object ' 用后期绑定，不用手动引用库
    Dim i As Long
    Dim keyValue As Variant
    Dim lastRow As Long
    
    ' 初始化对象
    Set BaseWorkbook = ThisWorkbook
    Set ws = BaseWorkbook.Sheets("Project Info")
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 关闭Excel的耗时操作，提升速度
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    On Error GoTo Cleanup ' 出错时也要恢复Excel设置
    
    ' 获取最后一行（避免无限循环）
    lastRow = ws.Cells(ws.Rows.Count, 10).End(xlUp).Row
    
    ' 从第3行开始遍历（你的代码里j从3开始，假设前2行是表头）
    For i = 3 To lastRow
        keyValue = ws.Cells(i, 10).Value
        ' 跳过空值
        If Not IsEmpty(keyValue) Then
            If dict.Exists(keyValue) Then
                ' 找到重复项，删除当前行
                ws.Rows(i).Delete
                ' 删除行后，行号要减1，不然会跳过下一行
                i = i - 1
                ' 更新最后一行（因为删除了一行）
                lastRow = lastRow - 1
            Else
                ' 首次出现，存入字典（值可以存行号，方便后续更新操作）
                dict.Add keyValue, i
            End If
        End If
    Next i
    
Cleanup:
    ' 恢复Excel的默认设置
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
    ' 释放对象
    Set dict = Nothing
    Set ws = Nothing
    Set BaseWorkbook = Nothing
    
    If Err.Number <> 0 Then
        MsgBox "执行出错：" & Err.Description, vbExclamation
    Else
        MsgBox "重复项处理完成！", vbInformation
    End If
End Sub

二、如果需要更新而不是删除重复项 #

如果找到重复项时，你想更新现有行（比如把当前行的某些数据合并到之前的行），只需要修改字典存在时的逻辑：

' 替换上面代码里的If dict.Exists(keyValue) Then部分
If dict.Exists(keyValue) Then
    ' 获取之前出现的行号
    Dim prevRow As Long
    prevRow = dict(keyValue)
    
    ' 示例：把当前行第11列（K列）的值加到之前行的K列
    ws.Cells(prevRow, 11).Value = ws.Cells(prevRow, 11).Value + ws.Cells(i, 11).Value
    
    ' 或者其他更新逻辑，比如覆盖某些列的值
    ' ws.Cells(prevRow, 12).Value = ws.Cells(i, 12).Value
    
    ' 更新完成后删除当前重复行
    ws.Rows(i).Delete
    i = i - 1
    lastRow = lastRow - 1
Else
    dict.Add keyValue, i
End If

关键说明 #

• 为什么用字典？：字典的Exists方法是哈希查找，比循环所有之前的行快得多，尤其是当数据有几百上千行的时候，差距会非常明显。
• 后期绑定 vs 早期绑定：上面用了CreateObject("Scripting.Dictionary")（后期绑定），好处是不用手动引用Microsoft Scripting Runtime库；如果要早期绑定，可以在VBA编辑器里选「工具」→「引用」，勾选Microsoft Scripting Runtime，然后把Dim dict As Object改成Dim dict As New Dictionary，代码提示会更友好。
• 行号处理：删除行后一定要把i减1，不然会跳过下一行（因为删除行后，后面的行都会往上移一行）。

内容的提问来源于stack exchange，提问作者Hoang Manh Ha