Amélioration de code

Le 18/11/2015 à 03:06

Bonsoir à tous, J'ai ce code qui gère une couleur pour un horaire de travail. Il contient une quinzaine de ligne pour CHAQUE jour de CHAQUE employé et ceci pour un horaire de deux semaines. J'ai plus de quinze employés sur la même sheet. Est-ce possible de simplifié ou raccourcir ce code?

Private Sub Worksheet_Activate()
Range("E4:E85").Font.Color = rgbSteelBlue
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell   As Range
    On Error Resume Next
    Application.EnableEvents = False
    For Each cell In Target
        cell = UCase(cell)
    Next
    Application.EnableEvents = True

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'
'                           EMPLOYÉ # 1
'
' Écriture du résultat des formules (heures)
' dans les cases appropriées
'
'
Select Case Range("CC4").Value
    Case Is > 0
        Range("C4").Value = Range("CC4").Value & " LG"
    Case Is = 0
        Range("C4") = ""
End Select
Select Case Range("CC5").Value
    Case Is > 0
        Range("D6").Value = Range("CC5").Value & " AG"
    Case Is = 0
        Range("D6") = ""
End Select
Select Case Range("CE4").Value
    Case Is > 0
        Range("D4").Value = Range("CE4").Value & " CK"
    Case Is = 0
        Range("D4") = ""
End Select
Select Case Range("CG4").Value
    Case Is > 0
        Range("C6").Value = Range("CG4").Value & " CS"
    Case Is = 0
        Range("C6") = ""
End Select
Select Case Range("CE5").Value
    Case Is > 0
        Range("E4").Value = Range("CE5").Value & " HRS"
    Case Is = 0
        Range("E4").Value = ""
End Select
Select Case Range("CX4").Value
    Case Is > 0
        Range("BL4").Value = Range("CX4").Value & " LG"
    Case Is = 0
        Range("BL4").Value = ""
End Select
Select Case Range("CX5").Value
    Case Is > 0
        Range("BM6").Value = Range("CX5").Value & " AG"
    Case Is = 0
        Range("BM6").Value = ""
End Select
Select Case Range("CZ4").Value
    Case Is > 0
        Range("BM4").Value = Range("CZ4").Value & " LG"
    Case Is = 0
        Range("BM4").Value = ""
End Select
Select Case Range("DB4").Value
    Case Is > 0
        Range("BL6").Value = Range("DB4").Value & " CS"
    Case Is = 0
        Range("BL6").Value = ""
End Select
Select Case Range("CZ5").Value
    Case Is > 0
        Range("BK4").Value = Range("CZ5").Value & " HRS"
    Case Is = 0
        Range("BK4").Value = ""
End Select
'
'
' DIMANCHE DE GAUCHE
'
Range("G4:J4").Font.Color = RGB(0, 0, 0)
If Range("J4").Value = "CK" Then Range("G4:J4").Font.Color = rgbMediumSeaGreen
If Range("J4").Value = "AG" Then Range("G4:J4").Font.Color = rgbDodgerBlue
If Range("G4").Value > 0 Then
    Range("H4").Value = "-"
    Else: Range("H4:J4").Value = ""
    End If

Range("G6:J6").Font.Color = RGB(0, 0, 0)
If Range("J6").Value = "CK" Then Range("G6:J6").Font.Color = rgbMediumSeaGreen
If Range("J6").Value = "AG" Then Range("G6:J6").Font.Color = rgbDodgerBlue
If Range("G6").Value > 0 Then
    Range("H6").Value = "-"
    Else: Range("H6:J6").Value = ""
    End If
'
' LUNDI DE GAUCHE
'
Range("K4:N4").Font.Color = RGB(0, 0, 0)
If Range("N4").Value = "CK" Then Range("K4:N4").Font.Color = rgbMediumSeaGreen
If Range("N4").Value = "AG" Then Range("K4:N4").Font.Color = rgbDodgerBlue
If Range("K4").Value > 0 Then
    Range("L4").Value = "-"
    Else: Range("L4:N4") = ""
    End If

Range("K6:N6").Font.Color = RGB(0, 0, 0)
If Range("N6").Value = "CK" Then Range("K6:N6").Font.Color = rgbMediumSeaGreen
If Range("N6").Value = "AG" Then Range("K6:N6").Font.Color = rgbDodgerBlue
If Range("K6").Value > 0 Then
    Range("L6").Value = "-"
    Else: Range("L6:N6") = ""
    End If
'
' MARDI DE GAUCHE
'
Range("O4:R4").Font.Color = RGB(0, 0, 0)
If Range("R4").Value = "CK" Then Range("O4:R4").Font.Color = rgbMediumSeaGreen
If Range("R4").Value = "AG" Then Range("O4:R4").Font.Color = rgbDodgerBlue
If Range("O4").Value > 0 Then
    Range("P4").Value = "-"
    Else: Range("P4:R4").Value = ""
    End If

Range("O6:R6").Font.Color = RGB(0, 0, 0)
If Range("R6").Value = "CK" Then Range("O6:R6").Font.Color = rgbMediumSeaGreen
If Range("R6").Value = "AG" Then Range("O6:R6").Font.Color = rgbDodgerBlue
If Range("O6").Value > 0 Then
    Range("P6").Value = "-"
    Else: Range("P6:R6").Value = ""
    End If
'
' MERCREDI DE GAUCHE
'
Range("S4:V4").Font.Color = RGB(0, 0, 0)
If Range("V4").Value = "CK" Then Range("S4:V4").Font.Color = rgbMediumSeaGreen
If Range("V4").Value = "AG" Then Range("S4:V4").Font.Color = rgbDodgerBlue
If Range("S4").Value > 0 Then
    Range("T4").Value = "-"
    Else: Range("T4:V4").Value = ""
    End If

Range("S6:V6").Font.Color = RGB(0, 0, 0)
If Range("V6").Value = "CK" Then Range("S6:V6").Font.Color = rgbMediumSeaGreen
If Range("V6").Value = "AG" Then Range("S6:V6").Font.Color = rgbDodgerBlue
If Range("S6").Value > 0 Then
    Range("T6").Value = "-"
    Else: Range("T6:V6").Value = ""
    End If
'
' JEUDI DE GAUCHE
'
Range("W4:Z4").Font.Color = RGB(0, 0, 0)
If Range("Z4").Value = "CK" Then Range("W4:Z4").Font.Color = rgbMediumSeaGreen
If Range("Z4").Value = "AG" Then Range("W4:Z4").Font.Color = rgbDodgerBlue
If Range("W4").Value > 0 Then
    Range("X4").Value = "-"
    Else: Range("X4:Z4").Value = ""
    End If

Range("W6:Z6").Font.Color = RGB(0, 0, 0)
If Range("Z6").Value = "CK" Then Range("W6:Z6").Font.Color = rgbMediumSeaGreen
If Range("Z6").Value = "AG" Then Range("W6:Z6").Font.Color = rgbDodgerBlue
If Range("W6").Value > 0 Then
    Range("X6").Value = "-"
    Else: Range("X6:Z6").Value = ""
    End If
'
' VENDREDI DE GAUCHE
'
Range("AA4:AD4").Font.Color = RGB(0, 0, 0)
If Range("AD4").Value = "CK" Then Range("AA4:AD4").Font.Color = rgbMediumSeaGreen
If Range("AD4").Value = "AG" Then Range("AA4:AD4").Font.Color = rgbDodgerBlue
If Range("AA4").Value > 0 Then
    Range("AB4").Value = "-"
    Else: Range("AB4:AD4").Value = ""
    End If

etc....
capture d ecran 10
Le 23/11/2015 à 13:04

Bonjour

Ce serait plus facile avec le fichier Sans données confidentielles

Cordialement

Rechercher des sujets similaires à "amelioration code"