Optimisation d'un code VBA pour EXCEL

Résolu
schmoe92 Messages postés 4 Statut Membre -  
Gord21 Messages postés 928 Statut Membre -
Bonjour,

Je viens de faire ce code et je n'arrive pas à le rendre plus simple.
Pouvez-vous m'aider ?

Sub UpdateWeek()

Application.ScreenUpdating = False
Windows("VAR_V20100308.xlsm").Activate
nb = Sheets("VAR_FR_TMP").PivotTables("TCD_VAR_FR_TMP1").PivotFields("Semaine").PivotItems.Count

For l = 1 To 3
With Sheets("VAR_FR_LE_TMP").PivotTables("TCD_VAR_FR_LE_TMP" & l)
For i = 2 To nb
With Sheets("VAR_FR_LE_TMP").PivotTables("TCD_VAR_FR_LE_TMP" & l).PivotFields("Semaine")
.PivotItems(i).Visible = False
End With
Next

For i = 2 To semaine(Now - 14)
With Sheets("VAR_FR_LE_TMP").PivotTables("TCD_VAR_FR_LE_TMP" & l).PivotFields("Semaine")
.PivotItems(i).Visible = True
End With
Next
End With
Next
For l = 1 To 3
With Sheets("VAR_FR_G500_TMP").PivotTables("TCD_VAR_FR_G500_TMP" & l)
For i = 2 To nb
With Sheets("VAR_FR_G500_TMP").PivotTables("TCD_VAR_FR_G500_TMP" & l).PivotFields("Semaine")
.PivotItems(i).Visible = False
End With
Next

For i = 2 To semaine(Now - 14)
With Sheets("VAR_FR_G500_TMP").PivotTables("TCD_VAR_FR_G500_TMP" & l).PivotFields("Semaine")
.PivotItems(i).Visible = True
End With
Next
End With
Next
For l = 1 To 3
With Sheets("VAR_FR_PUB_TMP").PivotTables("TCD_VAR_FR_PUB_TMP" & l)
For i = 2 To nb
With Sheets("VAR_FR_PUB_TMP").PivotTables("TCD_VAR_FR_PUB_TMP" & l).PivotFields("Semaine")
.PivotItems(i).Visible = False
End With
Next

For i = 2 To semaine(Now - 14)
With Sheets("VAR_FR_PUB_TMP").PivotTables("TCD_VAR_FR_PUB_TMP" & l).PivotFields("Semaine")
.PivotItems(i).Visible = True
End With
Next
End With
Next
For l = 1 To 3
With Sheets("VAR_FR_SMB_TMP").PivotTables("TCD_VAR_FR_SMB_TMP" & l)
For i = 2 To nb
With Sheets("VAR_FR_SMB_TMP").PivotTables("TCD_VAR_FR_SMB_TMP" & l).PivotFields("Semaine")
.PivotItems(i).Visible = False
End With
Next

For i = 2 To semaine(Now - 14)
With Sheets("VAR_FR_SMB_TMP").PivotTables("TCD_VAR_FR_SMB_TMP" & l).PivotFields("Semaine")
.PivotItems(i).Visible = True
End With
Next
End With
Next
For l = 1 To 5
With Sheets("VAR_FR_TMP").PivotTables("TCD_VAR_FR_TMP" & l)
For i = 2 To nb
With Sheets("VAR_FR_TMP").PivotTables("TCD_VAR_FR_TMP" & l).PivotFields("Semaine")
.PivotItems(i).Visible = False
End With
Next

For i = 2 To semaine(Now - 14)
With Sheets("VAR_FR_TMP").PivotTables("TCD_VAR_FR_TMP" & l).PivotFields("Semaine")
.PivotItems(i).Visible = True
End With
Next
End With
Next
For l = 1 To 4
With Sheets("DEC_TMP").PivotTables("TCD_AMOSTMP" & l)
For i = 2 To nb
With Sheets("DEC_TMP").PivotTables("TCD_AMOSTMP" & l).PivotFields("Semaine")
.PivotItems(i).Visible = False
End With
Next

For i = 2 To semaine(Now - 14)
With Sheets("DEC_TMP").PivotTables("TCD_AMOSTMP" & l).PivotFields("Semaine")
.PivotItems(i).Visible = True
End With
Next
End With
Next

Application.ScreenUpdating = True

End Sub

Merci pour votre aide
Ludo
Configuration: Windows Vista / Firefox 3.6

4 réponses

  1. Gord21 Messages postés 928 Statut Membre 289
     
    Bonsoir,
    Voici une proposition, je ne pense pas avoir fait d'erreur de copié-collé
    Sub UpdateWeek() 
    
    Dim PF_1 As PivotField
    Dim PF_2 As PivotField
    Dim PF_3 As PivotField
    Dim PF_4 As PivotField
    Dim PF_5 As PivotField
    
    Application.ScreenUpdating = False 
    Windows("VAR_V20100308.xlsm").Activate 
    nb = Sheets("VAR_FR_TMP").PivotTables("TCD_VAR_FR_TMP1").PivotFields("Semaine").PivotItems.Count 
    
    Set PF_1 = Sheets("VAR_FR_LE_TMP").PivotTables("TCD_VAR_FR_LE_TMP" & l).PivotFields("Semaine")
    Set PF_2 = Sheets("VAR_FR_G500_TMP").PivotTables("TCD_VAR_FR_G500_TMP" & l).PivotFields("Semaine")
    Set PF_3 = Sheets("VAR_FR_PUB_TMP").PivotTables("TCD_VAR_FR_PUB_TMP" & l).PivotFields("Semaine")
    Set PF_4 = Sheets("VAR_FR_SMB_TMP").PivotTables("TCD_VAR_FR_SMB_TMP" & l).PivotFields("Semaine")
    Set PF_5 = Sheets("VAR_FR_TMP").PivotTables("TCD_VAR_FR_TMP" & l).PivotFields("Semaine")
    Set PF_5 = Sheets("DEC_TMP").PivotTables("TCD_AMOSTMP" & l).PivotFields("Semaine")
    
    For l = 1 To 3 
       For i = 2 To semaine(Now - 14) 
          PF_1.PivotItems(i).Visible = True 
          PF_2.PivotItems(i).Visible = True
          PF_3.PivotItems(i).Visible = True
          PF_4.PivotItems(i).Visible = True
          PF_5.PivotItems(i).Visible = True
       Next
       For i = (semaine(Now - 14)+1) To nb 
          PF_1.PivotItems(i).Visible = False
          PF_2.PivotItems(i).Visible = False
          PF_3.PivotItems(i).Visible = False
          PF_4.PivotItems(i).Visible = False
          PF_5.PivotItems(i).Visible = False
       Next 
    Next 
     
    Application.ScreenUpdating = True 
    
    End Sub

    0
    1. schmoe92
       
      Bonsoir Gord21,
      Merci pour ta réponse.
      Lorsque je lance la macro, j'ai un message d'erreur au niveau des variable PF_x.
      "Impossible de lire la propriété PivotTables de la classe Worksheet"
      Que faire ?
      Merci
      0
      1. Gord21 Messages postés 928 Statut Membre 289 > schmoe92
         
        Bonsoir,
        J'ai remarqué une erreur dans mon code, je pensais que dans chaque boucles, tu avais l = 1 To 3 mais tes deux dernières boucles vont à 5 et 4 donc c'est un premier point qui ne vas pas mais ça ne devrait pas bloquer le code si le tien fonctionne. Je regarde et je te tiens au courant.
        Je n'avais pas testé le code, ça m'aiderai si tu me mettais le lien vers ton fichier (si c'est possible)

        @+
        0
      2. Gord21 Messages postés 928 Statut Membre 289 > schmoe92
         
        Bonjour,
        C'est bon j'ai retrouvé mon erreur. Je corrige et je te renvoie. En fait, je n'aurai pas besoin de ton fichier.
        @+
        0
  2. Gord21 Messages postés 928 Statut Membre 289
     
    Test
    Je n'arrive pas à ajouter un nouveau message.
    0
  3. Gord21 Messages postés 928 Statut Membre 289
     
    Voici la nouvelle version :
    Sub UpdateWeek() 
    
    Application.ScreenUpdating = False 
    Windows("VAR_V20100308.xlsm").Activate 
    nb = Sheets("VAR_FR_TMP").PivotTables("TCD_VAR_FR_TMP1").PivotFields("Semaine").PivotItems.Count 
    
    For l = 1 To 3 
       With Sheets("VAR_FR_LE_TMP").PivotTables("TCD_VAR_FR_LE_TMP" & l).PivotFields("Semaine") 
          For i = 2 To semaine(Now - 14) 
             .PivotItems(i).Visible = True  
          Next
          For i = (semaine(Now - 14)+1) To nb 
             .PivotItems(i).Visible = False
          Next 
       End With
       With Sheets("VAR_FR_G500_TMP").PivotTables("TCD_VAR_FR_G500_TMP" & l).PivotFields("Semaine") 
          For i = 2 To semaine(Now - 14) 
             .PivotItems(i).Visible = True  
          Next
          For i = (semaine(Now - 14)+1) To nb 
             .PivotItems(i).Visible = False
          Next 
       End With
       With Sheets("VAR_FR_PUB_TMP").PivotTables("TCD_VAR_FR_PUB_TMP" & l).PivotFields("Semaine") 
          For i = 2 To semaine(Now - 14) 
             .PivotItems(i).Visible = True  
          Next
          For i = (semaine(Now - 14)+1) To nb 
             .PivotItems(i).Visible = False
          Next 
       End With
       With Sheets("VAR_FR_SMB_TMP").PivotTables("TCD_VAR_FR_SMB_TMP" & l).PivotFields("Semaine") 
          For i = 2 To semaine(Now - 14) 
             .PivotItems(i).Visible = True  
          Next
          For i = (semaine(Now - 14)+1) To nb 
             .PivotItems(i).Visible = False
          Next 
       End With
    Next  
    For l = 1 To 5 
       With Sheets("VAR_FR_TMP").PivotTables("TCD_VAR_FR_TMP" & l).PivotFields("Semaine") 
          For i = 2 To semaine(Now - 14) 
             .PivotItems(i).Visible = True  
          Next
          For i = (semaine(Now - 14)+1) To nb 
             .PivotItems(i).Visible = False
          Next
       End With 
    Next 
    For l = 1 To 4 
       With Sheets("DEC_TMP").PivotTables("TCD_AMOSTMP" & l).PivotFields("Semaine")  
          For i = 2 To semaine(Now - 14) 
             .PivotItems(i).Visible = True  
          Next
          For i = (semaine(Now - 14)+1) To nb 
             .PivotItems(i).Visible = False
          Next 
       End With 
    Next 
    
    Application.ScreenUpdating = True 
    
    End Sub
    0
  4. schmoe92 Messages postés 4 Statut Membre
     
    Cool ca marche :-) Merci beaucoup
    0
    1. Gord21 Messages postés 928 Statut Membre 289
       
      Bonjour,
      Par curiosité, est-ce que tu gagnes beaucoup en temps d'exécution de ta macro ?
      @+
      0