Private Sub Worksheet_Change(ByVal Target As Range)
'si G5 n'a pas changé, on ne fait rien
If Not Intersect(Target, Range("g5")) Is Nothing Then
'Interception d'évènement inhibée
Application.EnableEvents = False
Dim i0 As Long, i As Long, i1 As Long
Dim j0 As Long, j As Long, j1 As Long, Sortie As Boolean
'Lecture des paramètres pour la feuille de saisie
Dim Feuille1 As Worksheet, rgValeurs As Range, Valeurs
Set Feuille1 = Sheets(Sheets("Param").Range("g1").Value)
Set rgValeurs = Feuille1.Range(Sheets("Param").Range("g2").Value)
Valeurs = rgValeurs.Value
'les 3 valeurs du triplet saisi doivent être non vides
If Len(rgValeurs(1, 1) & rgValeurs(1, 2) & rgValeurs(1, 3)) < 3 Then GoTo FIN
'Lecture des paramètres pour la feuille du tableau
Dim Feuille2 As Worksheet, rgtablo As Range, tablo, Pas
Dim col1, col2, col3, col4
Set Feuille2 = Sheets(Sheets("Param").Range("g4").Value)
Set rgtablo = Feuille2.Range(Sheets("Param").Range("g5").Value)
tablo = rgtablo.Value
col1 = Sheets("Param").Range("g6").Value
col2 = Sheets("Param").Range("g7").Value
col3 = Sheets("Param").Range("g8").Value
col4 = Sheets("Param").Range("g9").Value
Pas = Sheets("Param").Range("g10").Value
i0 = 1: i1 = UBound(tablo, 1)
j0 = 1: j1 = UBound(tablo, 2)
Sortie = False
'pour chaque ligne du tableau
For i = i0 To i1
'pour chaque motif du tableau
For j = j0 To j1 Step Pas
'le triplet saisi est-il égal au triplet du motif ?
If (Valeurs(1, 1) = tablo(i, col1 + j - 1)) And (Valeurs(1, 2) = tablo(i, col2 + j - 1)) _
And (Valeurs(1, 3) = tablo(i, col3 + j - 1)) Then
'Triplets égaux
tablo(i, col4 + j - 1) = Valeurs(1, 4)
Sortie = True
Exit For
End If
Next j
If Sortie Then Exit For
Next i
'écriture du tableau modifié
rgtablo = tablo
FIN:
'Interception d'évènement ré-activée
Application.EnableEvents = True
ElseIf Range("AE683") < 1 Or Range("AE683") > 16 Then
Exit Sub
ElseIf Not Application.Intersect(Target, Range("AC683:AD683")) Is Nothing Then
With Sheets("Feuil1")
'de la colonne C à la colonne ?? afin d'être large (au 11.09.2012, dernière colonne utilisée = 252)
For j = 3 To 300 Step 10
'de la ligne 5 à la ligne 100 afin d'être large.
'ATTENTION, IL Y A DEUX TABLEAUX L'UN SOUS L'AUTRE
For i = 5 To 100
If .Cells(i, j) = Range("AC683") And .Cells(i, j).Offset(0, 1) = Range("AD683") Then
' On a trouvé les bonnes cellules à modifier
If Range("AE683") <= 8 Then
.Range(.Cells(i, j).Offset(0, 2), .Cells(i, j).Offset(0, Range("AE683") + 1)).Interior.Color = 255 'Rouge
Else ' si Range("AE683") est entre 9 et 16
.Range(.Cells(i, j).Offset(0, 2), .Cells(i, j).Offset(0, Range("AE683") - 7)).Interior.Color = 16776960 'Bleu
If Range("AE683") < 16 Then
.Range(.Cells(i, j).Offset(0, Range("AE683") - 6), .Cells(i, j).Offset(0, 9)).Interior.Color = 9868950 'Gris
End If
End If
Exit Sub
End If
Next i
Next j
End With
End If
End Sub
