查重的问题

nsqrlj

zopey 发表于 2018-6-7 10:10
单列查重 等 怎么实现的呢 ，附件里 什么都看不到。

用字典也可以

nsqrlj

liulang0808 发表于 2018-6-7 10:11
colorindex这个有范围，注意范围
另外需求没有看懂，就结合目前附件做了案例，供参考

谢谢，如何改用更大范围的标识颜色，用color吗？

nsqrlj

liulang0808 发表于 2018-6-7 10:11
colorindex这个有范围，注意范围
另外需求没有看懂，就结合目前附件做了案例，供参考

For i = 1 To 10
    For j = 3 To 6
        If **** Then Cells(i, 1).Resize(, 1).Interior.ColorIndex = j
    Next
Next

liulang0808

nsqrlj 发表于 2018-6-7 10:21
谢谢，如何改用更大范围的标识颜色，用color吗？

这个楼主完全可以自己测试下的
关键要看色差大不大，不然看不出来差别的

zopey

Sub 按钮1_Click()
Dim d, arr, color_rnd
Set d = CreateObject("scripting.dictionary")

arr = Worksheets("sheet1").UsedRange
For i = 2 To UBound(arr)
   If Not d.exists(arr(i, 1) & arr(i, 2)) Then
      color_rnd = Application.RandBetween(1, 56)
      Range(Cells(i, 1), Cells(i, 2)).Interior.ColorIndex = color_rnd
      d(arr(i, 1) & arr(i, 2)) = color_rnd
   Else
      Range(Cells(i, 1), Cells(i, 2)).Interior.ColorIndex = d(arr(i, 1) & arr(i, 2))
   End If
Next

End Sub

Book2.zip (13.5 KB, 下载次数: 1)

2018-6-7 10:31 上传

点击文件名下载附件

nsqrlj

liulang0808 发表于 2018-6-7 10:06

你好，代码给无重复的也标识的颜色，如何处理？

nsqrlj

zopey 发表于 2018-6-7 10:32
Sub 按钮1_Click()
Dim d, arr, color_rnd
Set d = CreateObject("scripting.dictionary")

你好，代码给无重复的也标识的颜色，如何处理？

liulang0808

nsqrlj 发表于 2018-6-7 10:55
你好，代码给无重复的也标识的颜色，如何处理？

这个可以对合并单元格数量进行计数，如果超过两个就设置底色

nsqrlj

liulang0808 发表于 2018-6-7 10:57
这个可以对合并单元格数量进行计数，如果超过两个就设置底色

Sub test1()
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To 10
        d(Cells(i, 1) & Cells(i, 2)) = d(Cells(i, 1) & Cells(i, 2)) + 1
    Next
    For j = 0 To d.Count - 1
        If d.items()(j) > 1 Then Cells(j + 1, 1).Resize(, 2).Interior.ColorIndex = j + 2
    Next
End Sub
用这个好像也不严谨

nsqrlj

liulang0808 发表于 2018-6-7 10:28
这个楼主完全可以自己测试下的
关键要看色差大不大，不然看不出来差别的

谢谢，是要注意色差