指定列，单元格对比，依规则标记颜色

cqz2022

例子.rar (12.06 KB, 下载次数: 3)

2023-2-6 16:34 上传

点击文件名下载附件

  需求说有在图片里，谢谢，辛苦了

liulang0808

Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    For j = 2 To Cells(Rows.Count, 3).End(3).Row
        arr = Split("；" & Cells(j, 3), "；")
        Set d = CreateObject("scripting.dictionary")
        d.RemoveAll
        x = 1
        For i = 1 To UBound(arr)
            If Not d.exists(arr(i)) Then
                Set d(arr(i)) = CreateObject("scripting.dictionary")
            End If
            d(arr(i))(x) = x
            x = x + Len(arr(i)) + 1
        Next i
        For Each k In d.keys
            If d(k).Count > 1 Then
                 x = d(k).keys()(0)
                Cells(j, 3).Characters(x, Len(k)).Font.ColorIndex = 3
                For i = 1 To d(k).Count - 1
                    x = d(k).keys()(i)
                    Cells(j, 3).Characters(x, Len(k)).Font.ColorIndex = 8
                Next i
            End If
        Next k
    Next j
End Sub

liulang0808

第二个，在第一个基础上，删除添加蓝色的代码即可
另外录制一段，字体修改成黑色的代码，这段没有添加

cqz2022

liulang0808 发表于 2023-2-6 22:09
Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    For j = 2 To Cells(Rows.Cou ...

您好，怎样能在标记蓝色文字时包含分号。
谢谢