Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("E1:E1000")) Is Nothing Then
PremLig = ActiveCell.End(xlUp).Row
DerLig = ActiveCell.End(xlDown).Row
Range(Cells(PremLig, "E"), Cells(DerLig, "E")).Interior.Color = RGB(255, 255, 255)
Range(Cells(PremLig, "E"), Cells(DerLig, "E")).Font.Color = RGB(0, 0, 0)
For L = PremLig To DerLig
If Application.CountIf(Range(Cells(PremLig, "E"), Cells(DerLig, "E")), Cells(L, "E")) > 1 And _
Cells(L, "E").Interior.Color = RGB(255, 255, 255) Then
R = 1 + Int(254 * Rnd): G = 1 + Int(254 * Rnd): B = 1 + Int(254 * Rnd)
Chain = Cells(L, "E")
For L2 = L To DerLig
If Cells(L2, "E") = Chain Then
Cells(L2, "E").Interior.Color = RGB(R, G, B)
End If
Next L2
End If
Next L
End If
End Sub