Simplication Macro avec "Case"

Le 21/07/2012 à 08:02

Bonjour,

je souhaiterais simplifier la macro ci dessous afin de gagner en temps de calcul. Je vous ai mis le fichier en pièce jointe.

j'ai un calcul à faire en fonction du type de ces éléments ci dessous:

ROUTEUR

ANNEAU

BRASSEUR

BAS

ASBC

MGW

RTC

VOD

Je fais des boucles "if" à chaque fois et cela alourdit le temps. Y aurais-t-il un moyen pour simplifier cette macro ?

Merci d'avance pour votre aide

Sub suivi_charge_perspective()

Dim Lg As Long

Dim LgDer As Long

Dim ClDer As Long

Dim I As Long

Dim J As Long

Sheets("Suivi_charge_ingenieristes").Select

LgDer = Range("A65536").End(xlUp).Row

fin = Range("A" & Cells.Rows.Count).End(xlUp).Row

ClDer = Range("IV1").End(xlToLeft).Column

Range("BD4:CR600").Select

Selection.ClearContents

Date_MAD_souhaite = 12

Operation = 54

For I = 4 To fin

For J = 56 To 96

If Cells(I, Operation) = "ROUTEUR" Then

If CDate(Cells(I, Date_MAD_souhaite)) >= CDate(Cells(1, J)) And CDate(Cells(I, Date_MAD_souhaite)) <= CDate(Cells(2, J)) Then

Cells(I, J) = 1

toto = J - 3

If toto < 56 Then toto = 56

Range(Cells(I, 56), Cells(I, toto)) = ""

Range(Cells(I, toto), Cells(I, J)) = 1

End If

'.........................

End If

If Cells(I, Operation) = "ANNEAU" Then

If CDate(Cells(I, Date_MAD_souhaite)) >= CDate(Cells(1, J)) And CDate(Cells(I, Date_MAD_souhaite)) <= CDate(Cells(2, J)) Then

Cells(I, J) = 1

toto = J - 5

If toto < 56 Then toto = 56

Range(Cells(I, 56), Cells(I, toto)) = ""

Range(Cells(I, toto), Cells(I, J)) = 0.5

End If

'.........................

End If

If Cells(I, Operation) = "WDM" Then

If CDate(Cells(I, Date_MAD_souhaite)) >= CDate(Cells(1, J)) And CDate(Cells(I, Date_MAD_souhaite)) <= CDate(Cells(2, J)) Then

Cells(I, J) = 1

toto = J - 5

If toto < 56 Then toto = 56

Range(Cells(I, 56), Cells(I, toto)) = ""

Range(Cells(I, toto), Cells(I, J)) = 1

End If

'.........................

End If

If Cells(I, Operation) = "BRASSEUR" Then

If CDate(Cells(I, Date_MAD_souhaite)) >= CDate(Cells(1, J)) And CDate(Cells(I, Date_MAD_souhaite)) <= CDate(Cells(2, J)) Then

Cells(I, J) = 1

toto = J - 4

If toto < 56 Then toto = 56

Range(Cells(I, 56), Cells(I, toto)) = ""

Range(Cells(I, toto), Cells(I, J)) = 1

End If

'.........................

End If

If Cells(I, Operation) = "BAS" Then

If CDate(Cells(I, Date_MAD_souhaite)) >= CDate(Cells(1, J)) And CDate(Cells(I, Date_MAD_souhaite)) <= CDate(Cells(2, J)) Then

Cells(I, J) = 1

toto = J - 4

If toto < 56 Then toto = 56

Range(Cells(I, 56), Cells(I, toto)) = ""

Range(Cells(I, toto), Cells(I, J)) = 1

End If

'.........................

End If

If Cells(I, Operation) = "ASBC" Then

If CDate(Cells(I, Date_MAD_souhaite)) >= CDate(Cells(1, J)) And CDate(Cells(I, Date_MAD_souhaite)) <= CDate(Cells(2, J)) Then

Cells(I, J) = 1

toto = J - 4

If toto < 56 Then toto = 56

Range(Cells(I, 56), Cells(I, toto)) = ""

Range(Cells(I, toto), Cells(I, J)) = 1

End If

'.........................

End If

If Cells(I, Operation) = "RTC" Then

If CDate(Cells(I, Date_MAD_souhaite)) >= CDate(Cells(1, J)) And CDate(Cells(I, Date_MAD_souhaite)) <= CDate(Cells(2, J)) Then

Cells(I, J) = 1

toto = J - 2

If toto < 56 Then toto = 56

Range(Cells(I, 56), Cells(I, toto)) = ""

Range(Cells(I, toto), Cells(I, J)) = 1

End If

'.........................

End If

If Cells(I, Operation) = "VOD" Then

If CDate(Cells(I, Date_MAD_souhaite)) >= CDate(Cells(1, J)) And CDate(Cells(I, Date_MAD_souhaite)) <= CDate(Cells(2, J)) Then

Cells(I, J) = 1

toto = J - 3

If toto < 56 Then toto = 56

Range(Cells(I, 56), Cells(I, toto)) = ""

Range(Cells(I, toto), Cells(I, J)) = 1

End If

'.........................

End If

If Cells(I, Operation) = "MGW" Then

If CDate(Cells(I, Date_MAD_souhaite)) >= CDate(Cells(1, J)) And CDate(Cells(I, Date_MAD_souhaite)) <= CDate(Cells(2, J)) Then

Cells(I, J) = 1

toto = J - 2

If toto < 56 Then toto = 56

Range(Cells(I, 56), Cells(I, toto)) = ""

Range(Cells(I, toto), Cells(I, J)) = 1

End If

End If

Next J

Next I

MsgBox ("Calcul Terminé")

End Sub

8projection-charge-travail-2013-v5.zip (104.61 Ko)
Le 21/07/2012 à 09:42

Bonjour

A vérifier si je n'ai pas eu un mélange des yeux

Option Explicit

Sub suivi_charge_perspective()
Dim I As Long
Dim J As Long
Dim Fin As Long
Dim Date_MAD_souhaite As Integer
Dim Operation As Integer
Dim toto As Integer

  Sheets("Suivi_charge_ingenieristes").Select

  Fin = Range("A" & Cells.Rows.Count).End(xlUp).Row

  Range("BD4:CR600").ClearContents

  Date_MAD_souhaite = 12
  Operation = 54

  For I = 4 To Fin
    For J = 56 To 96
      If CDate(Cells(I, Date_MAD_souhaite)) >= CDate(Cells(1, J)) And _
         CDate(Cells(I, Date_MAD_souhaite)) <= CDate(Cells(2, J)) Then
        Select Case Cells(I, Operation)
          Case "ROUTEUR", "VOD"
            Cells(I, J) = 1
            toto = J - 3
            If toto < 56 Then toto = 56
            Range(Cells(I, 56), Cells(I, toto)) = ""
            Range(Cells(I, toto), Cells(I, J)) = 1
          Case "ANNEAU"
            Cells(I, J) = 1
            toto = J - 5
            If toto < 56 Then toto = 56
            Range(Cells(I, 56), Cells(I, toto)) = ""
            Range(Cells(I, toto), Cells(I, J)) = 0.5
          Case "WDM"
            Cells(I, J) = 1
            toto = J - 5
            If toto < 56 Then toto = 56
            Range(Cells(I, 56), Cells(I, toto)) = ""
            Range(Cells(I, toto), Cells(I, J)) = 1
          Case "BRASSEUR", "BAS", "ASBC"
            Cells(I, J) = 1
            toto = J - 4
            If toto < 56 Then toto = 56
            Range(Cells(I, 56), Cells(I, toto)) = ""
            Range(Cells(I, toto), Cells(I, J)) = 1
          Case "RTC", "MGW"
            Cells(I, J) = 1
            toto = J - 2
            If toto < 56 Then toto = 56
            Range(Cells(I, 56), Cells(I, toto)) = ""
            Range(Cells(I, toto), Cells(I, J)) = 1
        End Select
      End If
    Next J
  Next I
  MsgBox ("Calcul Terminé")
End Sub
Le 21/07/2012 à 14:54

Super merci, ca marche et j'ai gagné en temps de calcul

Rechercher des sujets similaires à "simplication macro case"