1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
| Sub doublons_sur_2_colonnes(ByVal Feuille As String, ByVal Deb As String, ByVal Fin As String) 'Nom de la feuille || 1ère Col || 2ème Col" (pour doublons)
Dim DLig As Long, Rg As Range, VA, C, Coll As New Collection, Cle As String, i As Long, L As String, Doublon, lig
Dim Coll_Coul As New Collection, r As Byte, G As Byte, B As Byte, FT As Boolean
Dim element As Variant
With Sheets(Feuille)
DLig = .Range(Deb & .Rows.Count).End(xlUp).Row
C = Array(.Columns(Deb).Count, .Columns(Deb & ":" & Fin).Count)
.Range(Deb & 2 & ":" & Deb & DLig).Interior.Color = xlNone
For Each element In Union(.Range(Fin & 2 & ":" & Fin & DLig), .Range(Deb & 2 & ":" & Deb & DLig))
element.Value = CleanTrim(element.Value)
Next element
VA = Application.Index(.Range(Deb & 1 & ":" & Fin & DLig).Value, Evaluate("ROW(1:" & DLig & ")"), C)
On Error Resume Next ' --------------------------------------------------------------------------------------------------------------
For i = 2 To UBound(VA)
Cle = VA(i, 1) & VA(i, 2)
Coll.Add i, Cle
If Err Then Err.Clear: L = Coll(Cle): Coll.Remove Cle: Coll.Add L & "|" & i, Cle
Next
i = 0
Application.ScreenUpdating = False
For Each Doublon In Coll
If InStr(Doublon, "|") > 0 Then
i = i + 1
For Each lig In Split(Doublon, "|")
If Rg Is Nothing Then Set Rg = .Range(Deb & lig) Else Set Rg = Union(Rg, .Range(Deb & lig))
Next
FT = False
Do
Randomize
r = 100 + (Round(Rnd * 135)): G = 150 + (Round(Rnd * 105)): B = 100 + (Round(Rnd * 155)):
Cle = r & " | " & G & " | " & B: Coll_Coul.Add Cle, Cle
If Not Err Then FT = True Else Err.Clear
Loop Until FT = True
Rg.Interior.Color = RGB(r, G, B)
End If
Set Rg = Nothing
Next
Application.ScreenUpdating = True
On Error GoTo 0 ' -------------------------------------------------------------------------------------------------------------------
End With
Set Coll = Nothing: Set Coll_Coul = Nothing
End Sub |
Partager