Question

我有这组代码无法正常运行。

它从 Sheets（“ one”）和 Sheets（“ two”）中获取名称列表，并应该查找唯一的名称并将其放在 Sheets（“三个”）。

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

从外观上看，它只占据了一个范围，并使得输出结果没有名称被过滤掉。

在此示例中，我在工作表“一个”上有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

此子项将计算每个名称的出现次数，然后删除所有不止一次出现的所有名称。

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

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

1 个答案: