Private Sub Worksheet_Activate()
'au cas où la plage "Incompa" ait été modifiée
Incompatibilité Cells, True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim plage As Range
Set plage = Intersect(Target, Range("A1:AD" & Range("A" & Rows.Count).End(xlUp).Row))
If Not plage Is Nothing Then Incompatibilité plage, False
End Sub
Sub Incompatibilité(plage As Range, ecran As Boolean)
Dim Incomp As Range, P As Range, PR As Range, c As Range
Dim r As Range, deb As Range, i, col, j, s1, s2, at1, x$, at2
Set Incomp = [Incompa]
Set P = Range("A1:AD" & Range("A" & Rows.Count).End(xlUp).Row)
If P.Rows.Count < 5 Then Exit Sub 'sécurité
If ecran Then Application.ScreenUpdating = False
'---RAZ des formats des plages "Nom" et définition de PR---
Application.EnableEvents = False 'désactive les événements
For Each c In [A4,D4,G4,J4,M4,P4,S4,V4,Y4,AB4]
If Not Intersect(c.Resize(, 3), plage.EntireColumn) Is Nothing Then
c.AutoFill c.Resize(P.Rows.Count - 3), xlFillFormats
Set PR = Union(IIf(PR Is Nothing, c(2), PR), c(2).Resize(P.Rows.Count - 4))
End If
Next
Application.EnableEvents = True 'réactive les événements
'---recherche des incompatibilités---
For Each c In Incomp.Columns(1).Cells
If c <> "" And c(, 2) <> "" Then
Set r = PR.Find(Trim(c), , xlValues, xlWhole, xlByColumns)
If Not r Is Nothing Then
Set deb = r 'mémorise la 1ère cellule
Do
i = r.Row: col = r.Column
j = Application.Match(Trim(c(, 2)), P.Columns(col), 0)
If IsNumeric(j) Then
s1 = Split(P(i, col + 2), "+")
s2 = Split(P(j, col + 2), "+")
For Each at1 In s1
x = LCase(Trim(at1))
For Each at2 In s2
If x = LCase(Trim(at2)) Then
Union(P(i, col), P(j, col)).Interior.ColorIndex = 1 'noir
Union(P(i, col), P(j, col)).Font.ColorIndex = 2 'blanc
Exit For
End If
Next at2
Next at1
End If
Set r = PR.Find(r, r) 'recherche suivante
Loop While r.Address <> deb.Address
End If
End If
Next c
End Sub
