Optimisation de code
e
Bonjour à tous,
j'ai réaliser un petit code pour des calcule de date de repos pour les agents travaillant le samedi et le dimanche.
Sub Worksheet_Change(ByVal Target As Range)
i = Target.Row
J = Target.Column
With Target(i)
If Weekday(Cells(i, 1)) = 1 Then ''-----------------------------------> dimanche
If Cells(i, J).Value = "Rh" Or Cells(i, J).Value = "" Then Exit Sub
Set r = Rows(i + 1).Find("Rh", , xlValues, xlWhole)
If Cells(367, 1).Value <> "" Then ' -----------------------------> année bisextil
If Cells(i + 1, 5) <> 8 Then
If r Is Nothing Then
Cells(i + 1, J).Value = "Rh"
Else
If Cells(i + 2, 5) <> 8 Then
Cells(i + 2, J).Value = "Rh"
Else
Cells(i + 3, J).Value = "Rh"
End If
End If
Else
Set r = Rows(i + 2).Find("Rh", , xlValues, xlWhole)
If r Is Nothing Then
Cells(i + 2, J).Value = "Rh"
Else
Cells(i + 3, J).Value = "Rh"
End If
End If
Else '--------------------------------------------------------> année normale
If i <> 366 Then
If Cells(i + 1, 5) <> 8 Then
If r Is Nothing Then
Cells(i + 1, J).Value = "Rh"
Else
If i <> 365 Then
If Cells(i + 2, 5) <> 8 Then
Cells(i + 2, J).Value = "Rh"
Else
Cells(i + 3, J).Value = "Rh"
End If
Else
If Cells(i + 3, 5) <> 8 Then
Cells(i + 3, J).Value = "Rh"
Else
Cells(i + 4, J).Value = "Rh"
End If
End If
End If
Else
Set r = Rows(i + 2).Find("Rh", , xlValues, xlWhole)
If r Is Nothing Then
Cells(i + 2, J).Value = "Rh"
Else
Cells(i + 3, J).Value = "Rh"
End If
End If
Else
If Cells(i + 2, 5) <> 8 Then
If r Is Nothing Then
Cells(i + 2, J).Value = "Rh"
Else
If Cells(i + 3, 5) <> 8 Then
Cells(i + 3, J).Value = "Rh" Else
Cells(i + 4, J).Value = "Rh"
End If
End If
Else
Set r = Rows(i + 3).Find("Rh", , xlValues, xlWhole)
If r Is Nothing Then
Cells(i + 3, J).Value = "Rh"
Else
Cells(i + 4, J).Value = "Rh"
End If
End If
End If
End If
End If
If Weekday(Cells(i, 1)) = 7 Then '-----------------------------------> Samedi
If i > 3 Then
If Cells(i, J).Value = "Rh" Or Cells(i, J).Value = "" Then Exit Sub
Set r = Rows(i - 1).Find("Rh", , xlValues, xlWhole)
If Cells(367, 1).Value <> "" Then ' -----------------------------> année bisextil
If Cells(i - 1, 5) <> 8 Then
If r Is Nothing Then
Cells(i - 1, J).Value = "Rh"
Else
If i > 4 Then
If Cells(i - 2, 5) <> 8 Then
Cells(i - 2, J).Value = "Rh"
Else
Cells(i - 3, J).Value = "Rh"
End If
End If
End If
Else
Set r = Rows(i + 2).Find("Rh", , xlValues, xlWhole)
If r Is Nothing Then
Cells(i - 2, J).Value = "Rh"
Else
Cells(i - 3, J).Value = "Rh"
End If
End If
Else '--------------------------------------------------------> année normale
If i > 3 Then
If Cells(i - 1, 5) <> 8 Then
If r Is Nothing Then
Cells(i - 1, J).Value = "Rh"
Else
If i > 4 Then
If Cells(i - 2, 5) <> 8 Then
Cells(i - 2, J).Value = "Rh"
Else
Cells(i - 3, J).Value = "Rh"
End If
Else
Exit Sub
End If
End If
Else
Set r = Rows(i - 2).Find("Rh", , xlValues, xlWhole)
If r Is Nothing Then
If (i - 2) <> 367 Then
Cells(i - 2, J).Value = "Rh"
Else
Set r = Rows(i - 3).Find("Rh", , xlValues, xlWhole)
If r Is Nothing Then
Cells(i - 3, J).Value = "Rh"
Else
Cells(i - 4, J).Value = "Rh"
End If
End If
End If
End If
Else
If Cells(i - 2, 5) <> 8 Then
If r Is Nothing Then
Cells(i - 2, J).Value = "Rh"
Else
If Cells(i - 3, 5) <> 8 Then
Cells(i - 3, J).Value = "Rh"
Else
Cells(i - 4, J).Value = "Rh"
End If
End If
Else
Set r = Rows(i - 3).Find("Rh", , xlValues, xlWhole)
If r Is Nothing Then
Cells(i - 3, J).Value = "Rh"
Else
Cells(i - 4, J).Value = "Rh"
End If
End If
End If
End If
End If
End If
End With
End SubJe me retrouve avec une multitude de If je voulais savoir si il était possible de simplifié le code,
Et je voulais ajouter une condition mais je n'ais pas réussi à l'écrire. pour l'instant je gère 3 personnes en repos mais je voulais ajouter une règle,.
Actuellement, par exemple, si Rh est déjà ecrit sur la i-1 je passe sur la ligne i-2 et j'inscrits Rh sur la nouvelle ligne.
Set r = Rows(i -2).Find("Rh", , xlValues, xlWhole)
If r Is Nothing ThenJe voulais ajouter une condition si nombre de rh de la ligne i-2 est supérieur au nombre de Rh de la ligne i-1 alors ecrire Rh en ligne i-1 sinon en i-2.
Avez vous des idées pour tous cela,
Merci d'avance pour vos réponses
Je vous laisse mon fichier pour des éventuelles tests.