Simplication Macro avec "Case"

[choudoudou]

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

 

[pyfux]

Re : Simplication Macro avec "Case"

Bonjour,

En effet, le "select case" est beaucoup plus adapté dans ce cas.
Il faut systématiquement penser : factorisation de code.

Cela le rend plus complexe mais beaucoup plus court.
Il faut trouver l'équilibre entre les 2!

Je vous propose:

-------------------------------------------------------------------

Sub suivi_charge_perspective_v2()

Dim Lg As Long
Dim LgDer As Long
Dim ClDer As Long
Dim I As Long
Dim J As Long

Dim bToTreat As Boolean
Dim nDeltaTOTO As Integer
Dim RangeVal As Double


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
        
        bToTreat = True
        
        Select Case UCase(Trim(Cells(I, Operation)))
            Case "ROUTEUR"
                nDeltaTOTO = 3
                RangeVal = 1
            Case "ANNEAU"
                nDeltaTOTO = 5
                RangeVal = 0.5
            Case "WDM"
                nDeltaTOTO = 5
                RangeVal = 1
            Case "BRASSEUR", "BAS", "ASBC"
                nDeltaTOTO = 4
                RangeVal = 1
            Case "RTC", "MGW"
                nDeltaTOTO = 2
                RangeVal = 1
            Case "VOD"
                nDeltaTOTO = 3
                RangeVal = 1
            Case Else
                bToTreat = False
        End Select
        
        If bToTreat 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 - nDeltaTOTO
                If toto < 56 Then toto = 56
                Range(Cells(I, 56), Cells(I, toto)) = ""
                Range(Cells(I, toto), Cells(I, J)) = RangeVal
            End If
        End If
    
    Next J
  Next I
  
  MsgBox ("Calcul Terminé")
  
End Sub

 

[choudoudou]

Re : Simplication Macro avec "Case"

Super merci effectivement, c'est bcp plus simple et rapide.
Merci pour votre aide

 

[Paritec]

Re : Simplication Macro avec "Case"

Bonjour Mrs Chodoudou pyfux, le forum
pourriez vous messieurs utiliser les balises de codes, que vos messages soient lisibles
merci pour nous
a+
papou