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



A voir également:

2 réponses

Réponse 1 / 2
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
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
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
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
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

            
    


    

            



    

        
        

            
        

    



    

    
            

        

        

    

        

            
        

    

    

    

        

        
        
        

                        Réponse 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