Simplification de programme

Le 28/06/2019 à 19:22

Bonjour, comme précisé dans le titre je voudrait simplifier ma macro qui fonctionne bien mais est tres longue ne sachant pas comment faire car je suis nul je voudrais votre aide

je vous joint la macro car je ne peux pas vous transmettre les fichiers car ils sont sur le reseau entreprise

merci d'avance

Sub ep2019_33100()

'equipe A

Dim plage1 As Range, plage2 As Range, jour, c As Range, j As Variant

If [[Planning_ep.xlsm]ep2019!c6] = 6 Then

Set plage1 = [[Planning_ep.xlsm]ep2019!F7:BE7]

Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5

jour = Array("jeu") 'liste à adapter

With Application

.ScreenUpdating = False

Range("C14:NC14").ClearContents

For Each c In Range("C14:NC14")

If UCase(c.Offset(-9)) = "A" Then 'M,A,N

If IsNumeric(.Match(c.Offset(-12), jour, 0)) Then

i = .Match(c.Offset(-11), plage2)

If IsNumeric(i) Then

If UCase(plage1(i)) = "A" Then

c = 6 'equipe

c.Select

Selection.Interior.Color = 255

Selection.Font.ThemeColor = xlThemeColorDark1

End If

End If

End If

End If

Next

End With

End If

'---------------------------------------------------------------------------------------------

'ep2019_33109

'equipe A

Dim plage13 As Range, plage14 As Range, jour7, c6 As Range, j6 As Variant

If [[Planning_ep.xlsm]ep2019!c33] = 6 Then

Set plage13 = [[Planning_ep.xlsm]ep2019!F34:BE34]

Set plage14 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5

jour7 = Array("ven", "sam", "dim") 'liste à adapter

With Application

.ScreenUpdating = False

For Each c In Range("C14:NC14")

If UCase(c.Offset(-9)) = "N" Then 'M,A,N

If IsNumeric(.Match(c.Offset(-12), jour7, 0)) Then

i = .Match(c.Offset(-11), plage14)

If IsNumeric(i) Then

If UCase(plage13(i)) = "A" Then

c = 6 'equipe

c.Select

Selection.Interior.Color = 255

Selection.Font.ThemeColor = xlThemeColorDark1

End If

End If

End If

End If

Next

End With

End If

'---------------------------------------------------------------------------------------------------

'33111

'equipe A

Dim plage25 As Range, plage26 As Range, jour13, c13 As Range, j13 As Variant

If [[Planning_ep.xlsm]ep2019!c39] = 6 Then

Set plage25 = [[Planning_ep.xlsm]ep2019!F40:BE40]

Set plage26 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5

jour13 = Array("mer") 'liste à adapter

With Application

.ScreenUpdating = False

For Each c In Range("C14:NC14")

If UCase(c.Offset(-9)) = "M" Then 'M,A,N

If IsNumeric(.Match(c.Offset(-12), jour13, 0)) Then

i = .Match(c.Offset(-11), plage26)

If IsNumeric(i) Then

If UCase(plage25(i)) = "A" Then

c = 6 'equipe

c.Select

Selection.Interior.Color = 255

Selection.Font.ThemeColor = xlThemeColorDark1

End If

End If

End If

End If

Next

End With

End If

'----------------------------------------------------------------------------------------

'ep2019_33118

'equipe A

Dim plage37 As Range, plage38 As Range, jour19, c19 As Range, j19 As Variant

If [[Planning_ep.xlsm]ep2019!c60] = 6 Then

Set plage37 = [[Planning_ep.xlsm]ep2019!F61:BE61]

Set plage38 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5

jour19 = Array("ven", "sam", "dim") 'liste à adapter

With Application

.ScreenUpdating = False

For Each c In Range("C14:NC14")

If UCase(c.Offset(-9)) = "N" Then 'M,A,N

If IsNumeric(.Match(c.Offset(-12), jour19, 0)) Then

i = .Match(c.Offset(-11), plage38)

If IsNumeric(i) Then

If UCase(plage37(i)) = "A" Then

c = 6 'equipe

c.Select

Selection.Interior.Color = 255

Selection.Font.ThemeColor = xlThemeColorDark1

End If

End If

End If

End If

Next

End With

End If

'----------------------------------------------------------------------------------------

'ep2019_33119

'equipe A

Dim plage49 As Range, plage50 As Range, jour25, c25 As Range, j25 As Variant

If [[Planning_ep.xlsm]ep2019!c63] = 6 Then

Set plage49 = [[Planning_ep.xlsm]ep2019!F64:BE64]

Set plage50 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5

jour25 = Array("ven", "sam", "dim") 'liste à adapter

With Application

.ScreenUpdating = False

For Each c In Range("C14:NC14")

If UCase(c.Offset(-9)) = "N" Then 'M,A,N

If IsNumeric(.Match(c.Offset(-12), jour25, 0)) Then

i = .Match(c.Offset(-11), plage50)

If IsNumeric(i) Then

If UCase(plage49(i)) = "A" Then

c = 6 'equipe

c.Select

Selection.Interior.Color = 255

Selection.Font.ThemeColor = xlThemeColorDark1

End If

End If

End If

End If

Next

End With

End If

'----------------------------------------------------------------------------------------

'ep2019_33160

'equipe A

Dim plage61 As Range, plage62 As Range, jour31, c31 As Range, j31 As Variant

If [[Planning_ep.xlsm]ep2019!c140] = 6 Then

Set plage61 = [[Planning_ep.xlsm]ep2019!F138:BE138]

Set plage62 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5

jour31 = Array("ven", "sam", "dim") 'liste à adapter

With Application

.ScreenUpdating = False

For Each c In Range("C14:NC14")

If UCase(c.Offset(-9)) = "N" Then 'M,A,N

If IsNumeric(.Match(c.Offset(-12), jour31, 0)) Then

i = .Match(c.Offset(-11), plage62)

If IsNumeric(i) Then

If UCase(plage61(i)) = "A" Then

c = 6 'equipe

c.Select

Selection.Interior.Color = 255

Selection.Font.ThemeColor = xlThemeColorDark1

End If

End If

End If

End If

Next

End With

End If

'----------------------------------------------------------------------------------------

'ep2019_33161

'equipe A

Dim plage73 As Range, plage74 As Range, jour37, c37 As Range, j37 As Variant

If [[Planning_ep.xlsm]ep2019!c143] = 6 Then

Set plage73 = [[Planning_ep.xlsm]ep2019!F141:BE141]

Set plage74 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5

jour37 = Array("ven", "sam", "dim") 'liste à adapter

With Application

.ScreenUpdating = False

For Each c In Range("C14:NC14")

If UCase(c.Offset(-9)) = "N" Then 'M,A,N

If IsNumeric(.Match(c.Offset(-12), jour37, 0)) Then

i = .Match(c.Offset(-11), plage74)

If IsNumeric(i) Then

If UCase(plage73(i)) = "A" Then

c = 6 'equipe

c.Select

Selection.Interior.Color = 255

Selection.Font.ThemeColor = xlThemeColorDark1

End If

End If

End If

End If

Next

End With

End If

'----------------------------------------------------------------------------------------

'ep2019_33162

'equipe A

Dim plage85 As Range, plage86 As Range, jour43, c43 As Range, j43 As Variant

If [[Planning_ep.xlsm]ep2019!c146] = 6 Then

Set plage85 = [[Planning_ep.xlsm]ep2019!F144:BE144]

Set plage86 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5

jour43 = Array("lun", "mar") 'liste à adapter

With Application

.ScreenUpdating = False

For Each c In Range("C14:NC14")

If UCase(c.Offset(-9)) = "N" Then 'M,A,N

If IsNumeric(.Match(c.Offset(-12), jour43, 0)) Then

i = .Match(c.Offset(-11), plage86)

If IsNumeric(i) Then

If UCase(plage85(i)) = "A" Then

c = 6 'equipe

c.Select

Selection.Interior.Color = 255

Selection.Font.ThemeColor = xlThemeColorDark1

End If

End If

End If

End If

Next

End With

End If

'----------------------------------------------------------------------------------------

'ep2019_33163

'equipe A

Dim plage97 As Range, plage98 As Range, jour49, c49 As Range, j49 As Variant

If [[Planning_ep.xlsm]ep2019!c155] = 6 Then

Set plage97 = [[Planning_ep.xlsm]ep2019!F153:BE153]

Set plage98 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5

jour49 = Array("ven", "sam", "dim") 'liste à adapter

With Application

.ScreenUpdating = False

For Each c In Range("C14:NC14")

If UCase(c.Offset(-9)) = "N" Then 'M,A,N

If IsNumeric(.Match(c.Offset(-12), jour49, 0)) Then

i = .Match(c.Offset(-11), plage98)

If IsNumeric(i) Then

If UCase(plage97(i)) = "A" Then

c = 6 'equipe

c.Select

Selection.Interior.Color = 255

Selection.Font.ThemeColor = xlThemeColorDark1

End If

End If

End If

End If

Next

End With

End If

'----------------------------------------------------------------------------------------

'ep2019_33101

'equipe A

Dim plage109 As Range, plage110 As Range, jour55, c55 As Range, j55 As Variant

If [[Planning_ep.xlsm]ep2019!c9] = 6 Then

Set plage109 = [[Planning_ep.xlsm]ep2019!F10:BE10]

Set plage110 = [[Planning_ep.xlsm]ep2019!F2:BE2] 'ligne 2 et non pas 5

jour55 = Array("lun", "mar", "mer", "jeu") 'liste à adapter

With Application

.ScreenUpdating = False

For Each c In Range("C14:NC14")

If UCase(c.Offset(-9)) = "M" Then 'M,A,N

If IsNumeric(.Match(c.Offset(-12), jour55, 0)) Then

i = .Match(c.Offset(-11), plage110)

If IsNumeric(i) Then

If UCase(plage109(i)) = "A" Then

c = 6 'equipe

c.Select

Selection.Interior.Color = 255

Selection.Font.ThemeColor = xlThemeColorDark1

End If

End If

End If

End If

Next

End With

End If

End Sub

Le 28/06/2019 à 20:45

Bonjour,

Il serait agréable de voir ton code sous balise ... </> .

Sans fichier pour tester ...

Un essai ...

Sous balise comme ici ...

Dim plage1 As Range, plage2 As Range, Jour, C As Range, j As Variant
Dim Lettre As String

Sub ep2019_33100()
   'equipe A
   If [[Planning_ep.xlsm]ep2019!c6] = 6 Then
      Set plage1 = [[Planning_ep.xlsm]ep2019!F7:BE7]
      Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2]      'ligne 2 et non pas 5
      Jour = Array("jeu")      'liste à adapter
      Lettre = "A"

      Call Module1.Traitement
   End If
   '---------------------------------------------------------------------------------------------
   'ep2019_33109
   'equipe A
   If [[Planning_ep.xlsm]ep2019!c33] = 6 Then
      Set plage1 = [[Planning_ep.xlsm]ep2019!F34:BE34]
      Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2]      'ligne 2 et non pas 5
      Jour = Array("ven", "sam", "dim")      'liste à adapter
      Lettre "N"

      Call Module1.Traitement
   End If
   '---------------------------------------------------------------------------------------------------
   '33111
   'equipe A
   If [[Planning_ep.xlsm]ep2019!c39] = 6 Then
      Set plage1 = [[Planning_ep.xlsm]ep2019!F40:BE40]
      Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2]      'ligne 2 et non pas 5
      Jour = Array("mer")      'liste à adapter
      Lettre = "M"

      Call Module1.Traitement
   End If
   '----------------------------------------------------------------------------------------
   'ep2019_33118
   'equipe A
   If [[Planning_ep.xlsm]ep2019!c60] = 6 Then
      Set plage1 = [[Planning_ep.xlsm]ep2019!F61:BE61]
      Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2]      'ligne 2 et non pas 5
      Jour = Array("ven", "sam", "dim")      'liste à adapter
      Lettre = "N"

      Call Module1.Traitement
   End If
   '----------------------------------------------------------------------------------------
   'ep2019_33119
   'equipe A
   If [[Planning_ep.xlsm]ep2019!c63] = 6 Then
      Set plage1 = [[Planning_ep.xlsm]ep2019!F64:BE64]
      Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2]      'ligne 2 et non pas 5
      Jour = Array("ven", "sam", "dim")      'liste à adapter
      Lettre = "N"

      Call Module1.Traitement
   End If
   '----------------------------------------------------------------------------------------
   'ep2019_33160
   'equipe A
   If [[Planning_ep.xlsm]ep2019!c140] = 6 Then
      Set plage1 = [[Planning_ep.xlsm]ep2019!F138:BE138]
      Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2]      'ligne 2 et non pas 5
      Jour = Array("ven", "sam", "dim")      'liste à adapter
      Lettre = "N"

      Call Module1.Traitement
   End If
   '----------------------------------------------------------------------------------------
   'ep2019_33161
   'equipe A
   If [[Planning_ep.xlsm]ep2019!c143] = 6 Then
      Set plage1 = [[Planning_ep.xlsm]ep2019!F141:BE141]
      Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2]      'ligne 2 et non pas 5
      Jour = Array("ven", "sam", "dim")      'liste à adapter
      Lettre = "N"

      Call Module1.Traitement
   End If
   '----------------------------------------------------------------------------------------
   'ep2019_33162
   'equipe A
   If [[Planning_ep.xlsm]ep2019!c146] = 6 Then
      Set plage1 = [[Planning_ep.xlsm]ep2019!F144:BE144]
      Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2]      'ligne 2 et non pas 5
      Jour = Array("lun", "mar")      'liste à adapter
      Lettre = "N"

      Call Module1.Traitement
   End If
   '----------------------------------------------------------------------------------------
   'ep2019_33163
   'equipe A
   If [[Planning_ep.xlsm]ep2019!c155] = 6 Then
      Set plage1 = [[Planning_ep.xlsm]ep2019!F153:BE153]
      Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2]      'ligne 2 et non pas 5
      Jour = Array("ven", "sam", "dim")      'liste à adapter
      Lettre = "N"

      Call Module1.Traitement
   End If

   '----------------------------------------------------------------------------------------
   'ep2019_33101
   'equipe A
   If [[Planning_ep.xlsm]ep2019!c9] = 6 Then
      Set plage1 = [[Planning_ep.xlsm]ep2019!F10:BE10]
      Set plage2 = [[Planning_ep.xlsm]ep2019!F2:BE2]      'ligne 2 et non pas 5
      Jour = Array("lun", "mar", "mer", "jeu")      'liste à adapter
      Lettre = "M"

      Call Module1.Traitement
   End If
End Sub

Sub Traitement()

   With Application
      .ScreenUpdating = False
      Range("C14:NC14").ClearContents
      For Each C In Range("C14:NC14")
         If UCase(C.Offset(-9)) = Lettre Then      'M,A,N
            If IsNumeric(.Match(C.Offset(-12), Jour, 0)) Then
               i = .Match(C.Offset(-11), plage2)
               If IsNumeric(i) Then
                  If UCase(plage1(i)) = Lettre Then
                     C = 6      'equipe
                     C.Select
                     Selection.Interior.Color = 255
                     Selection.Font.ThemeColor = xlThemeColorDark1
                  End If
               End If
            End If
         End If
      Next C
   End With
End Sub

ric

Rechercher des sujets similaires à "simplification programme"