VBA计数并在发现重复值时打印每个单元格地址

我试图计算发现重复值的单元格数 然后在消息框中打印它们。 目前，我的代码成功地找到了值，但只打印具有第二个重复值的单元格，而不是所有具有相同值的单元格。一定是这样的：

For Each C In rng1   
    If Len(C.Value) > 0 Then
        If Not objDic.exists(C.Value) Then
            objDic.Add C.Value, CStr(C.Address)
        Else
            objDic(C.Value) = objDic(C.Value) & ", " & CStr(C.Address)
        End If
    End If
Next

Dim comma As String, strMsg As String
strMsg = ""
For Each i In objDic.Keys
    pcs = Split(objDic(i), ",")
    If Ubound(pcs) > 1 Then
        strMsg = strMsg & "The id" & i & " is used multiple times "
        comma = ""
        For Each p In pcs
            strMsg = strMsg & comma & p
            comma = ", "
        Next
        strMsg = strMsg & vbNewLine
    End If
Next
If Len(strMsg) > 0 Then MsgBox strMsg

id“错误id”被多次使用（“id”）。 *所有单元格的ID，用逗号分隔。在本例中为“A6，A7”。以下是我的代码：

Sub sbFindDuplicatesInColumn()

Dim cell As Range
Dim mess As String
Dim rngcheck As Range
Dim rng1 As Range
Dim C As Range
Dim objDic
Dim strMsg As String

Set objDic = CreateObject("scripting.dictionary")
Set rng1 = Range([a1], Cells(Rows.count, "A").End(xlUp))
For Each C In rng1

    If Len(C.Value) > 0 Then
        If Not objDic.exists(C.Value) Then
            objDic.Add C.Value, 1
        Else
            strMsg = strMsg & "The id" & C.Value & " is used multiple times " & C.Address(0, 0) & vbNewLine
        End If
    End If
Next
    If Len(strMsg) > 0 Then MsgBox strMsg
End Sub

---

您可以这样做，首先调用

SetUpDictionary

，然后使用

CheckDupe

函数进行检查

Private dDupeChecker As Scripting.Dictionary

Function CheckDupe(rCheck As Excel.Range) As String
    If dDupeChecker.Exists(CStr(rCheck.Value)) Then
        CheckDupe = dDupeChecker(CStr(rCheck.Value))
    Else
        CheckDupe = "Ok, not a duplicate"
    End If
End Function

Sub SetUpDictionary()

Dim rFindOn As Excel.Range
Dim rLookAt As Excel.Range

Set dDupeChecker = New Scripting.Dictionary

Set rFindOn = Range("a1:a10")

For Each rLookAt In rFindOn.Cells
    If dDupeChecker.Exists(CStr(rLookAt.Value)) Then
        dDupeChecker(CStr(rLookAt.Value)) = dDupeChecker(CStr(rLookAt.Value)) & "," & rLookAt.Address
    Else
        dDupeChecker.Add CStr(rLookAt.Value), rLookAt.Address
    End If
Next rLookAt

End Sub

那么，假设您的列表是

1
2
3
1
5
2

您的预期输出是：

The id '1' is used multiple times: A1, A4
The id '2' is used multiple times: A2, A6

但您的实际输出是

The id '1' is used multiple times: A4
The id '2' is used multiple times: A6

这是因为您不存储索引值的第一次遭遇，只存储遇到它的

试着这样做：

For Each C In rng1   
    If Len(C.Value) > 0 Then
        If Not objDic.exists(C.Value) Then
            objDic.Add C.Value, CStr(C.Address)
        Else
            objDic(C.Value) = objDic(C.Value) & ", " & CStr(C.Address)
        End If
    End If
Next

Dim comma As String, strMsg As String
strMsg = ""
For Each i In objDic.Keys
    pcs = Split(objDic(i), ",")
    If Ubound(pcs) > 1 Then
        strMsg = strMsg & "The id" & i & " is used multiple times "
        comma = ""
        For Each p In pcs
            strMsg = strMsg & comma & p
            comma = ", "
        Next
        strMsg = strMsg & vbNewLine
    End If
Next
If Len(strMsg) > 0 Then MsgBox strMsg

---

因此，为了清楚起见，您需要一个消息框来表示“ID x在[Location 1]、[Location 2]、[Location 3]、[Location 4]等处多次使用”，对吗？显示所有找到的单元格为什么不使用COUNTIF是正确的？因为我想像宏制作msgbx一样执行此操作：

MsgBox dDupeChecker（CStr（rLookAt.Value））&“&rLookAt.Address

但是它显示了第二个重复的twiceYes，因为您已经添加了它rLookAt.Address，您不需要，它存储在字典中，在这里我收到了类型不匹配

如果Len（pcs）>1，那么

这里我认为每个I“not k”都必须是

在objDic.Keys中

但它可以打印每个值的所有单元格：D