找出EXCEL中值相同的单元格并且按不同的颜色标识

Sub Macro1()
Dim arr, i, j
Dim d As Object, mkey
 Dim mHight, s
'On Error Resume Next
Set d = CreateObject("scripting.dictionary")
d.CompareMode = TextCompare
arr = Range("A1:E21")
For j = 1 To 5
 For i = 1 To UBound(arr)
 If Len(arr(i, j)) <> 0 Then
d(arr(i, j)) = d(arr(i, j)) & "," & Chr(j + 64) & i
 End If
 Next
 Next
For Each mkey In d.keys
    If UBound(Split(d(mkey), ",")) > 1 Then
    mHight = mHight + 16
    s = mkey & "有重复,位置为:" & Mid(d(mkey), 2) & Chr(10) & s
    Dim strCity()     As String
    strCity = Split(Mid(d(mkey), 2), ",")
    For intloop = 0 To UBound(strCity)
        Range(strCity(intloop)).Select
        x = Int(Rnd() * 255)
        y = Int(Rnd() * 255)
        Z = Int(Rnd() * 255)
        With Selection.Font
            '.Color = RGB(x, y, Z)
            .TintAndShade = 0
        End With
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = RGB(x, y, Z)
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Next intloop
End If
Next

If mHight = 0 Then
    TextBox1.Text = "没有发现重复单元格"
Else
    MsgBox (s)
End If
End Sub

转载于:https://www.cnblogs.com/chinhr/archive/2010/03/10/1682389.html