每个单元格内重复姓名_字体标红色

绿色心情小天使

大家E友好：
每个单元格内（B列）重复姓名_字体标红色，并弹出消息框：“XXX重复”的提示，达到结果如下图。
7.13同名.zip (7.96 KB, 下载次数: 17)

2023-7-14 12:04 上传

点击文件名下载附件

3190496160

Sub yanse()
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("报名")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    .Columns("B:B").Font.ColorIndex = 0
    For i = 2 To r
        d.RemoveAll
        If Trim(.Cells(i, 2)) <> "" Then
            If InStr(.Cells(i, 2), "、") > 0 Then
                rr = Split(.Cells(i, 2), "、")
                For s = 0 To UBound(rr)
                    If rr(s) <> "" Then
                        d(rr(s)) = d(rr(s)) + 1
                    End If
                Next s
                zf = Trim(.Cells(i, 2))
                For Each k In d.keys
                    sl = d(k)
                    If sl > 1 Then
                        wz = InStr(zf, k)
                        gs = Len(k)
                        .Cells(i, 2).Characters(Start:=wz, Length:=gs).Font.ColorIndex = 3
                        wz = InStrRev(zf, k)
                        gs = Len(k)
                        .Cells(i, 2).Characters(Start:=wz, Length:=gs).Font.ColorIndex = 3
                    End If
                Next k
            End If
        End If
    Next i
End With
MsgBox "ok!"
End Sub

3190496160

3190496160

7.13同名.rar (17 KB, 下载次数: 9)

2023-7-14 12:25 上传

点击文件名下载附件

绿色心情小天使

3190496160 发表于 2023-7-14 12:25

只要每天日期里有同名的显示红色

ykcbf1100

附件供参考。。。

准提部林

Sub TEST_A1()
Dim X As Range, T$, n%, c1%, c2%
[b2:b32].Font.ColorIndex = 0
For Each X In [b2:b32]
    n = 0: T = "、" & X & "、"
    For Each a In Split(X, "、")
        c1 = InStr(T, "、" & a & "、")
        c2 = InStrRev(T, "、" & a & "、")
        If c1 <> c2 Then X.Characters(n + 1, Len(a)).Font.ColorIndex = 3
        n = n + Len(a) + 1
    Next
Next
End Sub

grf1973

参与一下。在六楼的基础上改了一下。

yanglinzi

三楼只能标出两个重复值，六楼所有重复都能标出。

gwjkkkkk

参与一下。。。