|
本帖最后由 Johnnyc 于 2023-2-23 16:35 编辑
代碼如下:
Sub Check_duplicates()
Dim d As Object
Dim rng As Range
Dim str As String
Dim i As Integer
Dim k, j
Set d = CreateObject("scripting.dictionary")
For Each rng In Range("B2:B" & Range("B65536").End(xlUp).Row)
If Not d.exists(rng.Value) Then
d.Add rng, 1
Else '<---不能正确地进入此"else"部分
MsgBox rng
If str = "" Then
str = rng
Else
str = "儲存格" & rng.Address & "出現重覆"
End If
i = i + 1
d(rng) = d(rng) + 1
End If
Next
If i > 0 Then
MsgBox str
End If
'MsgBox d.Count '顯示字典總數
k = d.keys
j = d.items
Range("F1:G1000").ClearContents
Range("F2").Resize(d.Count, 1) = Application.WorksheetFunction.Transpose(k)
Range("G2").Resize(d.Count, 1) = Application.WorksheetFunction.Transpose(j)
MsgBox "結論:字典顯示有" & d.Count & "個不重覆的Key(但實際應只有4個),不知為什麼字典不能查出重覆並透過msgbox等動作提示"
'结论:B栏,字典显示有5个不重复的Key(但实际应只有4个),不知为什么字典不能查出重复并透过msgbox等动作提示
Set d = Nothing
End Sub
|
|