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
| Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$4" Then 'F4 est la liste
For i = 2 To Worksheets("Responsable").Range("C" & Rows.Count).End(xlUp).Row
If Range("F4").Value = Worksheets("Responsable").Cells(i, 3).Value Then
Range("F5").Value = Worksheets("Responsable").Range("D" & i).MergeArea.Cells(1, 1).Value 'récupère la valeur de la cellule fusionnée
Exit For
End If
Next
Else
If Target.Address = "$F$5" Then
Else
Dim txt As String
If Target.Row > 1 Then
For i = 2 To 4
txt = txt & Trim("" & Cells(Target.Row, 1).Offset(0, i))
Next
End If
If Len(txt) > 1 Then MsgBox "Erreur, veuillez remplir une seule case par ligne !"
End If
End If
End Sub
Private Sub color_case()
Select Case Range("C51").Value
Case 0 To 0.4
Range("F56").Interior.ColorIndex = 3
Case 0, 41 To 0.6
Range("F57").Interior.ColorIndex = 44
Case 0.61 To 0.8
Range("F58").Interior.ColorIndex = 28
Case 0.81 To 1
Range("F59").Interior.ColorIndex = 4
End Select
End Sub |
Partager