从 2 个给定范围创建一个唯一的名称列表

Question

我的这组代码运行不正确。

它从 Sheets("one") 和 Sheets("two") 中获取名称列表，并且应该找到唯一的名称并将它们放在 表格（“三个”）。

• 两个列表都只是文本字符串。
• 两个列表不是连续的，这意味着一个名字可能在 与其他范围不同的行。它没有特定的顺序。

从外观上看，它只是取了一个完整的范围并使其输出，没有过滤掉任何名称。

对于这个例子，我在工作表“一”上有 150 个名字，而工作表“二”上有 160 个名字。我应该只在“三”表上看到大约 10 个唯一值。但是我得到的返回值正好是 160。

有什么想法吗？

Sub dupes()

Dim arrRanges(1) As Excel.Range
Dim dDedupe As New Scripting.Dictionary
Dim lngCounter As Long
Dim rngInspect As Excel.Range

Set arrRanges(0) = Sheets("one").Range("A2:A1000")
Set arrRanges(1) = Sheets("two").Range("A2:A1000")

For lngCounter = 0 To 1

    For Each rngInspect In arrRanges(lngCounter).cells
        If Not dDedupe.Exists(CStr(rngInspect.Value)) Then
            dDedupe.Add CStr(rngInspect.Value), dDedupe.count
        End If
    Next rngInspect

Next lngCounter

'Output
Sheets("three").Range("A2").Resize(dDedupe.count).Value = Application.Transpose(dDedupe.Keys())

End Sub

Answer 1

从问题的措辞来看，我假设您只想提取在数据中出现一次的名称（这就是为什么比较 150 和 160 个名称的列表应该只输出 10 个名称，这些名称只出现一次） .

您的代码本身很好，但您的代码中没有任何地方实际处理/删除重复项，试试这个调整后的代码：

Sub dupes()

Dim arrRanges(1) As Excel.Range
Dim dDedupe As New Scripting.Dictionary
Dim lngCounter As Long
Dim rngInspect As Excel.Range
Dim strKey As String

Set arrRanges(0) = Sheets("one").Range("A2:A" & Sheets("one").Cells(Rows.Count, 1).End(xlUp).Row)
Set arrRanges(1) = Sheets("two").Range("A2:A" & Sheets("two").Cells(Rows.Count, 1).End(xlUp).Row)

For lngCounter = 0 To 1

    For Each rngInspect In arrRanges(lngCounter).Cells
        strKey = CStr(rngInspect.Value)
        If dDedupe.Exists(strKey) Then
            dDedupe(strKey) = dDedupe(strKey) + 1
        Else
            dDedupe.Add strKey, 1
        End If
    Next rngInspect

Next lngCounter

For Each Key In dDedupe.Keys()
    If dDedupe(Key) > 1 Then dDedupe.Remove Key
Next Key
'Output
Sheets("three").Range("A2").Resize(dDedupe.Count).Value = Application.Transpose(dDedupe.Keys())

End Sub

这个sub会统计每个名字出现的次数，然后删除所有出现多次的名字。

一种更有效的方法是将所有名称存储在一个数组中（而不是将两个不同的范围存储在一个数组中）并循环遍历该数组而不是逐个访问每个单元格。