VBA 如何根据现有列表检查重复值并仅添加新列表中的唯一实例

Question

我有三个工作表 headers，但列数不同：

活动列表
当前列表
新列表

我需要将“新列表”中的 A 列与“活动列表”中的 B 列进行比较，以了解重复实例。我只想加载从第 2 行开始的 A 列中的唯一实例以及 B 列和 C 列中“活动列表”工作表的最后填充行下方的“新列表”中 B 列中的关联单元格。

为此，我尝试使用脚本字典，但我在以下代码行中的 object 范围内收到运行时间错误 1004：

Dict.Add Key:=NL.Range(i, "A").Value, Item:=vbNullString

这是我从 Whosebug 上的问题 #55499372 中模仿的完整代码：

Sub load_new()

 Dim LastRow As Long
 Dim i As Long
 
 Dim Dict As Scripting.Dictionary
 Set Dict = New Scripting.Dictionary
 Dim CL As Worksheet
 Set CL = ThisWorkbook.Worksheets("CURRENT LIST")
 Dim NL As Worksheet
 Set NL = ThisWorkbook.Worksheets("NEW LIST")
 Dim AL As Worksheet
 Set AL = ThisWorkbook.Worksheets("ACTIVE LIST")

    'Retrieves the last row of column A
    With NL
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
 
    For i = 2 To LastRow
        Dict.Add Key:=NL.Range(i, 1).Value, Item:=vbNullString
    Next i
    

    'Retrieves the last row of column B
    With AL
        LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
    End With

    For i = 2 To LastRow
        If Not Dict.Exists(AL.Range(i, 2).Value) Then
        End If
    Next i

End Sub

Answer 1

使用活动列表列 B 中的键加载字典，然后扫描新列表列 A 检查键是否不存在。

Option Explicit

Sub load_new()

    Dim wsCL As Worksheet, wsNL As Worksheet, wsAL As Worksheet
    Dim LastRowAL As Long, LastRowNL As Long
    Dim i As Long, n As Long, key As String
    
    Dim Dict As Scripting.dictionary
    Set Dict = New Scripting.dictionary
    With ThisWorkbook
        'Set wsCL = .Sheets("CURRENT LIST")
        Set wsNL = .Sheets("NEW LIST")
        Set wsAL = .Sheets("ACTIVE LIST")
    End With

    ' Active List
    With wsAL
        LastRowAL = .Cells(.Rows.Count, "B").End(xlUp).Row
        For i = 2 To LastRowAL
            key = Trim(.Cells(i, "B"))
            If Len(key) > 0 Then
                Dict.Add key, i
            End If
        Next i
    End With
 
    ' New List
    With wsNL
        LastRowNL = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To LastRowNL
            key = Trim(.Cells(i, "A"))
            If Not Dict.Exists(key) Then
                LastRowAL = LastRowAL + 1
                wsAL.Cells(LastRowAL, "B") = key
                wsAL.Cells(LastRowAL, "C") = .Cells(i, "B")
               n = n + 1
            End If
        Next i
    End With
    MsgBox n & " rows added to " & wsAL.Name

End Sub

VBA 如何根据现有列表检查重复值并仅添加新列表中的唯一实例

VBA How to check for duplicate values against existing list and add only unique instances from new list

excel

vba

dictionary

loops

duplicates