时间戳

首页 > 解决方案 > 查找重复项并列出相应的值

excel - 查找重复项并列出相应的值

问题描述

我有以下代码从 B 列中提取重复项并计算重复项的数量，并列出 A 列中与每个重复值相关的值..

Sub Find_Duplicate()
Dim ky, cl As Range, i As Long
Dim d1 As Object, d2 As Object

Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
For Each cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
    d1.Item(cl.Value) = d1.Item(cl.Value) + 1
    d2.Item(cl.Value) = d2.Item(cl.Value) & ";" & cl.Offset(0, -1).Value
Next cl

i = 3
For Each ky In d1.Keys
    If d1.Item(ky) > 1 Then
        i = i + 1
        Cells(i, 5).Resize(1, 3).Value = Array(ky, d1.Item(ky), Mid(d2.Item(ky), 2))
    End If
Next ky
End Sub

事实上，代码运行良好，完全没有问题

我想知道有没有办法在这个例子中使用一个字典对象而不是字典对象的两个实例......？

标签： excelvba

解决方案

可能有很多方法可以实现这一点，但您可以尝试：继续仅使用示例中的第二个字典，计算最终值中的分隔符（“;”）的数量。您可以通过以下方式实现：

For Each ky In d2.Keys
    cond = (UBound(Split(d2.Item(ky), ";"))
    If cond > 1 Then
        i = i + 1
        Cells(i, 5).Resize(1, 3).Value = Array(ky, cond, Mid(d2.Item(ky), 2))
    End If
Next ky

您现在可以删除示例的 d1 。祝你好运！

推荐阅读