以不同颜色显示某列重复项

爱疯

这是我一个求助问题，得到了大家的帮助，后来阿木解决了。

自己觉得这个功能还是有点用吧，有点趣。就对：数据源、某列、是否包含标题行和最后显示，几方面作了通用性更改，但判断主要算法还是使用阿木的。尽管题目不难，但我想了半天，还是想不出别的判断算法，更不谈比阿木的好。

希望能把这修改得更规范，更合理，更好。无论哪方面不好，请各位多给建议！

工作簿1.rar (12.88 KB, 下载次数: 58)

2011-7-13 01:04 上传

点击文件名下载附件

Zipall

回复 爱疯 的帖子

来个不排序的.

1. 
   
2. Sub ColorMe()
   
3.     On Error Resume Next
   
4.     c = InputBox("请输入列标", , "C")
   
5.     r = Cells(65536, c).End(xlUp).Row
   
6.     arr = Cells(1, c).Resize(r, 1).Value
   
7.    
   
8.     '获取重复次数
   
9.     Set d = CreateObject("scripting.dictionary")
   
10.     For i = 1 To r
    
11.         d(arr(i, 1)) = d(arr(i, 1)) + 1
    
12.     Next i
    
13.    
    
14.    
    
15.     '判断是否需要上色并随机出颜色值
    
16.     ks = d.keys
    
17.     its = d.items
    
18.     For i = 0 To UBound(ks)
    
19.         If its(i) > 1 Then
    
20.             d.Item(ks(i)) = RGB(Int(Rnd * 99) + 99, Int(Rnd * 99) + 99, Int(Rnd * 99) + 99)
    
21.         Else
    
22.             d.Item(ks(i)) = xlNone
    
23.         End If
    
24.     Next
    
25.    
    
26.     '逐行查字典赋予颜色值
    
27.     t = Cells(1, 256).End(xlToLeft).Column
    
28.     For i = 1 To r
    
29.         Cells(i, 1).Resize(1, t).Interior.Color = d(arr(i, 1))
    
30.     Next
    
31.     Set d = Nothing
    
32. End Sub
    

复制代码