同一日期挑重复项

cb_clx

怎样把同一日期里面品名重复的用颜色标识出来，并且只保留重复项中的一项，见附件！
请各位老师帮忙解答，谢谢！

liyizhe000

Sub tttt()
Dim d, arr
Dim i As Integer
arr = Range("a2:g" & Range("a65536").End(xlUp).Row)
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
If Not d.Exists(arr(i, 3)) Then
d(arr(i, 3)) = arr(i, 7)
Else
d(arr(i, 3)) = d(arr(i, 3)) + arr(i, 7)
End If
Next
Sheets.Add after:=Sheet1
Range("a1").Resize(d.Count) = Application.Transpose(d.Keys)
Range("b1").Resize(d.Count) = Application.Transpose(d.Items)
End Sub