EXCEL VBA实现重复字段出现次数并列显示

Sub dotest()   'Dim arr, dApplication.ScreenUpdating = FalseSet d = CreateObject("Scripting.Dictionary")With Sheets("Sheet2")r = .Cells(.Rows.Count, "a").End(xlUp).Rowarr = .[a1].Resize(r, 1)End WithFor i = 2 To UBound(arr)s = arr(i, 1)d(s) = d(s) + 1NextWith Sheets("Sheet1")r = .Cells(.Rows.Count, "a").End(xlUp).Rowarr = .[a1].Resize(r, 2)For i = 2 To UBound(arr)s = arr(i, 1)If d.exists(s) ThenIf d(s) > 1 Thenarr(i, 2) = d(s)Elsearr(i, 2) = ""End IfEnd IfNext.[a1].Resize(r, 2) = arrEnd WithSet d = NothingApplication.ScreenUpdating = TrueMsgBox "OK！"
End Sub