Excel 2003: macro trop lentes

plastickman Messages postés 66 Statut Membre -  
plastickman Messages postés 66 Statut Membre -
Bonjour à tous,
Je sais bien que ce genre de problème est récurant sous Excel, mais après avoir bien supprimé toutes les colonnes et lignes inutiles je ne sais plus très bien quoi faire pour pour accélérer le déroulement de mes macros notamment les plus longues.
Voici ci-dessous les trois principales fautives, les codes suivants sont surtout des adaptations de ce que j'ai trouvé dans les différentes discussions des forums et mon niveau en VBA ne permet pas de faire beaucoup mieux, alors si quelqu'un pense qu'il y a possibilité d'améliorer je suis preneur.
Merci,

Sub LOCAUX()
Dim ModeRecalcul As Long

ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Range("n92:n137").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
For Each o In Selection
If o.Value <> "" Then
o.EntireRow.Hidden = False
End If
Next

Dim NomFeuille As String, Reponse As Boolean
NomFeuille = "mission"
Reponse = FeuilleExiste(NomFeuille)
If Reponse = True Then
Sheets("mission").Select
Range("B24:B68").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
Range("B24:B68").Select
For Each o In Selection
If o.Value <> "" Then
o.EntireRow.Hidden = False
End If
Next
Range("c75:c120").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
Range("c75:c120").Select
For Each o In Selection
If o.Value <> "" Then
o.EntireRow.Hidden = False
End If
Next
End If

NomFeuille = "amiante 1"
Reponse = FeuilleExiste(NomFeuille)
If Reponse = True Then
Sheets("amiante 1").Select
Range("B10:B54").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
Range("B10:B54").Select
For Each o In Selection
If o.Value <> "" Then
o.EntireRow.Hidden = False
End If
Next
Range("C8").Select
End If

NomFeuille = "MESURAGE"
Reponse = FeuilleExiste(NomFeuille)
If Reponse = True Then
Sheets("MESURAGE").Select
Range("B22:B66").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
Range("B22:B66").Select
For Each o In Selection
If o.Value <> "" Then
o.EntireRow.Hidden = False
End If
Next
Range("H71:H115").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
Range("H71:H115").Select
For Each o In Selection
If o.Value <> "" Then
o.EntireRow.Hidden = False
End If
Next
Range("F22").Select
End If

NomFeuille = "inspection"
Reponse = FeuilleExiste(NomFeuille)
If Reponse = True Then
Sheets("inspection").Select
Range("B27:B71").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
Range("B27:B71").Select
For Each o In Selection
If o.Value <> "" Then
o.EntireRow.Hidden = False
End If
Next
Range("H78:H122").Select
For Each o In Selection
If o.Value = "0" Then
o.EntireRow.Hidden = True
End If
Next
Range("H78:H122").Select
For Each o In Selection
If o.Value <> "0" Then
o.EntireRow.Hidden = False
End If
Next
Range("H129:H173").Select
For Each o In Selection
If o.Value = "0" Then
o.EntireRow.Hidden = True
End If
Next
Range("H129:H173").Select
For Each o In Selection
If o.Value <> "0" Then
o.EntireRow.Hidden = False
End If
Next
End If

NomFeuille = "installation & anomalies"
Reponse = FeuilleExiste(NomFeuille)
If Reponse = True Then
Worksheets("installation & anomalies").Activate
Range("k697:k741").Select
For Each o In Selection
If o.Value = "0" Then
o.EntireRow.Hidden = True
End If
Next
Range("k697:k741").Select
For Each o In Selection
If o.Value <> "0" Then
o.EntireRow.Hidden = False
End If
Next
Range("D10").Select
End If

NomFeuille = "anomalies"
Reponse = FeuilleExiste(NomFeuille)
If Reponse = True Then
Worksheets("anomalies").Activate
Range("j350:j394").Select
For Each o In Selection
If o.Value = "0" Then
o.EntireRow.Hidden = True
End If
Next
Range("j350:j394").Select
For Each o In Selection
If o.Value <> "0" Then
o.EntireRow.Hidden = False
End If
Next
Range("E18").Select
End If

NomFeuille = "descriptif"
Reponse = FeuilleExiste(NomFeuille)
If Reponse = True Then
Sheets("descriptif").Select
Range("j10:j144").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
Range("j10:j144").Select
For Each o In Selection
If o.Value <> "" Then
o.EntireRow.Hidden = False
End If
Next
Range("j150:j194").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
Range("j150:j194").Select
For Each o In Selection
If o.Value <> "" Then
o.EntireRow.Hidden = False
End If
Next
Range("D10").Select
End If

Worksheets("Renseignements").Activate

Range("b92").Select
Application.Calculation = ModeRecalcul
Application.ScreenUpdating = True

End Sub
--------------------------------------------------------------------------------------------------------------
Function FeuilleExiste(MaFeuille As String) As Boolean

Dim Feuille As Worksheet

FeuilleExiste = False
For Each Feuille In Worksheets
If (Feuille.Name = MaFeuille) Then
FeuilleExiste = True
End If
Next Feuille

End Function

Sub tableau()

Application.ScreenUpdating = False
Range("v11:v1011").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
Range("A11").Select
Application.ScreenUpdating = True
End Sub

Sub Conclusion()
Dim ModeRecalcul As Long

ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Sheets("conclusion").Activate
Range("D14:D424").Select
For Each o In Selection
If o.Value = "NON" Then
o.EntireRow.Hidden = True
End If
Next
For Each o In Selection
If o.Value = "DOUTE" Then
o.EntireRow.Hidden = True
End If
Next
For Each o In Selection
If o.Value = "0" Then
o.EntireRow.Hidden = True
End If
Next
Range("D430:D840").Select
For Each o In Selection
If o.Value = "NON" Then
o.EntireRow.Hidden = True
End If
Next
For Each o In Selection
If o.Value = "OUI" Then
o.EntireRow.Hidden = True
End If
Next
For Each o In Selection
If o.Value = "0" Then
o.EntireRow.Hidden = True
End If
Next
Dim myvar As String, i As Integer, X As Boolean
i = 14
X = True
Do While i <> 424
If Range("D" & i).Value = "OUI" Then
X = False
Exit Do
End If
i = i + 1
Loop
If X = False Then Rows("5:6").RowHeight = 0.15
If X = True Then Rows("7:8").RowHeight = 0.15

Worksheets("fiche récapitulative").Activate
Call Tri_Efface_doubles([B7:B51])
Call Tri_Efface_doubles([B54:B98])
Call Tri_Efface_doubles([B101:B192])
Call Tri_Efface_doubles([B195:B286])
Call Tri_Efface_doubles([B289:B334])
Call Tri_Efface_doubles([B337:B382])
Call Tri_Efface_doubles([B385:B429])

Range("B7:B51").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
For Each o In Selection
If o.Value = "0" Then
o.EntireRow.Hidden = True
End If
Next
Range("B54:B98").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
For Each o In Selection
If o.Value = "0" Then
o.EntireRow.Hidden = True
End If
Next
Range("B101:B192").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
For Each o In Selection
If o.Value = "0" Then
o.EntireRow.Hidden = True
End If
Next
Range("B195:B286").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
For Each o In Selection
If o.Value = "0" Then
o.EntireRow.Hidden = True
End If
Next
Range("B289:B334").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
For Each o In Selection
If o.Value = "0" Then
o.EntireRow.Hidden = True
End If
Next
Range("B337:B382").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
For Each o In Selection
If o.Value = "0" Then
o.EntireRow.Hidden = True
End If
Next
Range("B385:B429").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
For Each o In Selection
If o.Value = "0" Then
o.EntireRow.Hidden = True
End If
Next

Range("i435:i845").Select
For Each o In Selection
If o.Value = "NON" Then
o.EntireRow.Hidden = True
End If
Next
For Each o In Selection
If o.Value = "DOUTE" Then
o.EntireRow.Hidden = True
End If
Next
For Each o In Selection
If o.Value = "0" Then
o.EntireRow.Hidden = True
End If
Next
Range("i852:i1262").Select
For Each o In Selection
If o.Value = "NON" Then
o.EntireRow.Hidden = True
End If
Next
For Each o In Selection
If o.Value = "OUI" Then
o.EntireRow.Hidden = True
End If
Next
For Each o In Selection
If o.Value = "0" Then
o.EntireRow.Hidden = True
End If
Next

Sheets("FACTURE - devis").Select
Range("F46:F49").Select
For Each o In Selection
If o.Value = "" Then
o.EntireRow.Hidden = True
End If
Next
Range("F46:F49").Select
For Each o In Selection
If o.Value <> "" Then
o.EntireRow.Hidden = False
End If
Next
Sheets("Renseignements").Activate
If Range("l23") <> 1 Then
Sheets(Array("couverture DTA", "fiche récapitulative")).Delete
End If
If Range("l23") = 1 Then
Sheets("amia").Delete
End If
Sheets("conclusion").Activate
Range("c10").Select
Application.Calculation = ModeRecalcul
Application.ScreenUpdating = True
End Sub

2 réponses

  1.
    michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Bonjour,

    en VBA, évite autant que faire se peut les select-selection qui ralentissent fortement le déroulement...

    ainsi: 
    NomFeuille = "mission"
If FeuilleExiste(NomFeuille) Then
    With Sheets(nomfeuille)
        For Each o In .Range("B24:B68")
            If o.Value = "" Then
                Rows(o.Row).Hidden = True
            Else
                Rows(o.Row).Hidden = False
            End If
        Next
    End With
End If


    la modif sur toutes tes feuilles devrait déjà te faire gagner pas mal de temps...

    tu as aussi intérêt à utiliser des sous-macros paramétrées... 

    Sub test1()
cacher_pascacher "mission", "B24:B68"
cacher_pascacher "mission", "C75:C120"
End Sub

Sub cacher_pascacher(nomfeuille As String, plage As String)
Dim o As Range
If FeuilleExiste(nomfeuille) Then
     With Sheets(nomfeuille)
        For Each o In .Range(plage)
            If o.Value = "" Then
                Rows(o.Row).Hidden = True
            Else
                Rows(o.Row).Hidden = False
            End If
        Next
    End With
End If

End Sub


    je regarde un autre des tes codes à améliorer (boucle inutile)
    0
    1. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      re,
      au lieu de 
      i = 14
X = True
Do While i <> 424
If Range("D" & i).Value = "OUI" Then
X = False
Exit Do
End If
i = i + 1
Loop
If X = False Then Rows("5:6").RowHeight = 0.15
If X = True Then Rows("7:8").RowHeight = 0.15


      essaies 
      If Application.CountIf(Range("D14:D424"), "OUI") = 0 Then
    Rows("7:8").RowHeight = 0.15
Else
    Rows("5:6").RowHeight = 0.15
End If



      remarque;
      a l'avenir n'aoublie pas d'insérer tes codes entre les balises <> en cliquant sur l'ongleet avec les balises rouges (en haut et à droite des messages, Merci
      0
    2. plastickman Messages postés 66 Statut Membre 6
       
      Bonjour michel_m,
      J'ai enfin eu le temps de me replonger dans toutes mes macros et de tester ce que tu m'as envoyé. Voici ce que cela donne: 
      Sub LOCAUX()

      Dim ModeRecalcul As Long

      

      ModeRecalcul = Application.Calculation

      Application.Calculation = xlCalculationManual

      Application.ScreenUpdating = False

      

      For Each o In Range("n92:n137")

      If o.Value = "" Then

      o.EntireRow.Hidden = True

      Else

      o.EntireRow.Hidden = False

      End If

      Next

      

          

      

       NomFeuille = "mission"

      cacher_pascacher_vide "mission", "B24:B68"

      cacher_pascacher_vide "mission", "c75:c120"

      

      

       NomFeuille = "amiante 1"

      cacher_pascacher_vide "amiante 1", "B10:B54"

      Range("C8").Select

      

      NomFeuille = "MESURAGE"

      cacher_pascacher_vide "MESURAGE", "B22:B66"

      cacher_pascacher_vide "MESURAGE", "H71:H115"

      Range("F22").Select

      

      

      NomFeuille = "inspection"

      cacher_pascacher_vide "inspection", "B27:B71"

      cacher_pascacher_zéro "inspection", "H78:H122"

      cacher_pascacher_zéro "inspection", "H129:H173"

      

      

      NomFeuille = "installation & anomalies"

      cacher_pascacher_zéro "installation & anomalies", "k697:k741"

      Range("D10").Select

       

      

      NomFeuille = "anomalies"

      cacher_pascacher_zéro "anomalies", "j350:j394"

      Range("E18").Select

      

       NomFeuille = "descriptif"

       cacher_pascacher_vide "descriptif", "j10:j144"

        cacher_pascacher_vide "descriptif", "j150:j194"

      Range("D10").Select

      

      Worksheets("Renseignements").Activate

      

      

      Range("b92").Select

      Application.Calculation = ModeRecalcul

      Application.ScreenUpdating = True

      

      

      End Sub

      Function FeuilleExiste(MaFeuille As String) As Boolean

      

          Dim Feuille As Worksheet

          

          FeuilleExiste = False

          For Each Feuille In Worksheets

              If (Feuille.Name = MaFeuille) Then

                  FeuilleExiste = True

              End If

          Next Feuille

          

      End Function

      Sub cacher_pascacher_vide(NomFeuille As String, plage As String)

      Dim o As Range

      If FeuilleExiste(NomFeuille) Then

           With Sheets(NomFeuille)

           Sheets(NomFeuille).Activate

              For Each o In .Range(plage)

                  If o.Value = "" Then

                      Rows(o.Row).Hidden = True

                  Else

                      Rows(o.Row).Hidden = False

                  End If

              Next

          End With

      End If

      

      End Sub

      Sub cacher_pascacher_zéro(NomFeuille As String, plage As String)

      If FeuilleExiste(NomFeuille) Then

           With Sheets(NomFeuille)

          Sheets(NomFeuille).Activate

              For Each o In .Range(plage)

                  If o.Value = "0" Then

                      Rows(o.Row).Hidden = True

                  Else

                      Rows(o.Row).Hidden = False

                  End If

              Next

          End With

      End If

      

      End Sub

      

      

      

      

      

      Comme tu l'as sans doute constaté j'ai rajouté la ligne:

      Sheets(NomFeuille).Activate
      

      dans la sous-macro, sinon toutes les action "masquer" se faisaient sur la feuille où j'ai positionné le bouton.

      

      Je te confirme bien que les temps de déroulement des codes ont diminué mais de façon plus ou moins significative, selon que je supprime des onglets dans mon classeur ou non. Lorsque je lance un code en les conservant  tous le déroulement reste encore très lent. A part ça , j'ai supprimé dans toutes les autres macros les "sélection" comme tu me l'as conseillé. 

      Merci encore pour ton aide précieuse.

      

      jp
    
      


      
    


    
    0

            
    


    

            



    
      
        
        
      
            
        
      
    
      

      
    
      
                                                            
      
        
      3. 
        
    
    
    

    2. 

  2. 

    
    
    

        
    
    
    
        
    
            
    
            
    
            
    

            
    
    
    
            
    

    
    
    
    
        

        

        
    

                    plastickman
    
        
    
                    Messages postés
            
                
    

            66
        
            
                                    Statut
            Membre
                    



    
            
                
    

                        6
        
        

    
     
    
        
    
            
    
                                Bonjour,

    Merci beaucoup pour ton aide et tous ces conseils. Je vais essayer ça et je te tiens au courant. 

    Concernant la remarque, c'est noté, je me demandais justement à quoi servait cet onglet.

    

    jp
                            
    
                
    


    
    0

            
    




            



    
    
        
        
    
            
        
    
    
    

    
    
    


            

                    

    
    
    
    
      
            
    
    
    

    3.