vba : eviter les recalculs automatiques, accélérer une macro

[Amauty]

Bonjour à tous,
J'ai coder une macro qui fonctionne très bien sur ma machine ainsi que sur celle des autres. Le probème c'est que la macro est très lente sur la machine du principal utilisateur (sans que je puisse l'expliquer). Je suis donc tomber sur ce fil https://www.excel-downloads.com/threads/macro-tres-lente.145158/ et ai récupéré en particulier ce bout de code que j'ai insérer dans ma macro :
Re : Macro tres lente

Bonjour zoubitom, bonjour à tous,

Pour éviter les récalculs systématiques inutiles, tu mets:

en début de macro:
Code :
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

et en fin de macro:
Code :
Application.ScreenUpdating = true
Application.Calculation = xlCalculationAutomatic

@+

Gael

et voila que la fin de ma macro ne fonctionne plus :

For Each sh1 In Sheets(Array("ALTO", "AVSV", "AVTS", "ATEMPORAL", "PREMIUM", "CLASSIC", "FML"))
sh1.Select
    fin = [B65536].End(xlUp).Row
    If fin < 5 Then fin = 4
    
    For i = 4 To fin
    If Cells(i, 3).Value Like "*ALTA VISTA*" Then Exit For
    Next i
    
    Cells(i, 1).Select
    Set c = selection
        
    For i2 = 3 To 9
        If Sheets("resume").Cells(6, i2).Text = ActiveSheet.name Then Exit For
    Next i2
Sheets("resume").Select
Cells(13, i2) = c

Next sh1

En fait, en ajoutant ce bout de macro, au lieu que "c" me renvoit la valeur souhaitée, elle me renvoit systématiquement 1 ou rien du tout dans la case appropriée de la feuille résumé Alors qu'elle devrait m'afficher 5 puis 12 etc...qui sont le rang d'Alta Vista en fonction d'un segment de marché (chaque feuille de mon classeur représente un segment de marché et la feuille résumé reprend le classement de Alta vista sur chaque segment)

Tout le reste de ma macro (plusieurs pages tout de même) fonctionne parfaitement, sauf ce morceau...
Quelqu'un a-t-il une idée ?

Merci !

Amaury

 

[Bebere]

Re : vba : eviter les recalculs automatiques, accélérer une macro

bonjour Amaudy
un fichier avec quelques données et le code serait le bienvenu
si tu veux accélérer le code oublie les select et employer find(fonction recherche)
à bientôt

 

[Amauty]

Re : vba : eviter les recalculs automatiques, accélérer une macro

Bonjour Bebere,
J'ai tenté de simplifier le fichier et la macro et cela demeure beaucoup trop lourd pour vous le faire parvenir (et les bugs sont multiples suite à la suppression de données). j'ai trouvé la solution mais le mystère persiste. J'ai simplement repasser en mode calcul automatique

Application.Calculation = xlCalculationAutomatic

avant le bout de code qui pose problème. N'empêche que je ne comprends pas. La macro est plus rapide (je passe de 12 secondes à 3 secondes sur ma machine, sur celle de mon collègue je ne sais pas encore).

Enfin, peux-tu m'en dire un peu plus sur la fonction find qui remplace le select car j'ai tenté à plusieurs reprise de supprimer des select, sans succès.

Merci pour ton aide

Amaury

 

[Bebere]

Re : vba : eviter les recalculs automatiques, accélérer une macro

Amauty
le code de find vient de l'aide
à tester

Sub f()

For Each sh1 In Sheets(Array("ALTO", "AVSV", "AVTS", "ATEMPORAL", "PREMIUM", "CLASSIC", "FML"))
 '   fin = [B65536].End(xlUp).Row
 '   If fin < 5 Then fin = 4
   With Worksheets(sh1.Name).UsedRange.Columns(3)
        Set c = .Find(What:="ALTA VISTA", LookIn:=xlValues, LookAt:=xlPart)
        If Not c Is Nothing Then
               firstAddress = c.Address
        Do
               fResume (c.Value)
               
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
 
        End If
        End With
Next sh1

End Sub

Sub fResume(mot)

With Worksheets("resume").UsedRange.Columns(3)
    For i2 = 3 To 9
        If .Cells(6, i2).Text = ActiveSheet.Name Then Exit For
    Next i2
.Cells(13, i2) = mot
End With

End Sub

 

[Amauty]

Re : vba : eviter les recalculs automatiques, accélérer une macro

Bebere,
merci pour ce code, je suis en train de l'adapter et même s'il me parait plus compliqué que mon code, il me permet d'apprendre beaucoup sur l'utilisation de sub imbriqué dans un autre. J'ai adapté ton code aux réalités de mon fichier et voici le résultat.

Sub f()

For Each sh1 In Sheets(Array("ALTO", "AVSV", "AVTS", "ATEMPORAL", "PREMIUM", "CLASSIC", "FML"))
    With Worksheets(sh1.name).UsedRange.Columns(3)
        Set c = .Find(What:="ALTA VISTA", LookIn:=xlValues, LookAt:=xlPart)
        If Not c Is Nothing Then
              Set c = Cells(c.Row, c.Column - 2)
              fResume (c.Value)
        End If
    End With
Next sh1

End Sub

Sub fResume(rang)

With Worksheets("resume")
    For i2 = 3 To 9
        If .Cells(6, i2).Text = sh1.name Then Exit For
    Next i2
.Cells(13, i2) = rang
End With

End Sub

Demeure un souçi, j'aimerai que la fonction fresume (rang) accepte le sh1 qui est défini dans la sub f(). Le débogueur débogue à cet endroit...

Bravo pour l'habileté à ne pas utiliser le select.

et merci pour cet apprentissage.

A tout à l'heure

Amaury

 

[Bebere]

Re : vba : eviter les recalculs automatiques, accélérer une macro

Amauty,tu déclares
dim shl as worksheet en début de feuille(au dessus de sub f(),si il n'y a rien d'autre)

 

[Amauty]

Re : vba : eviter les recalculs automatiques, accélérer une macro

Re,

J'ai finalement réussi à trouver le souçi, il s'agissait simplement d'utilise := à l'argument de la sub pour lui assigner une valeur.
Au final voici mon code qui fonctionne :

For Each sh1 In Sheets(Array("ALTO", "AVSV", "AVTS", "ATEMPORAL", "PREMIUM", "CLASSIC", "FML"))
    With Worksheets(sh1.name).UsedRange.Columns(3)
        Set c = .Find(What:="ALTA VISTA", LookIn:=xlValues, LookAt:=xlPart)
        If Not c Is Nothing Then
              Set c = sh1.Cells(c.Row, c.Column - 2)
              frangmarcas c.Value, sh2:=sh1.name
        End If
    End With
Next sh1

Sub frangmarcas(rang As Variant, sh2 As String)

With Worksheets("resume")
    For i2 = 3 To 9
            If .Cells(6, i2).Text = sh2 Then Exit For
    Next i2
    .Cells(13, i2) = rang
End With

End Sub

avec le fichier en lien pour mieux comprendre la macro

merci en tout cas pour votre aide et les pistes données.

Amaury

 

[Bebere]

Re : vba : eviter les recalculs automatiques, accélérer une macro

bonjour Amauty
bien déclaré les variables accélère le code,éviter d'employer des mots clés(range,val,etc)
lire l'aide à ce sujet

Sub macro1()

Dim sh1 As Worksheet, c As Range

For Each sh1 In Sheets(Array("ALTO", "AVSV", "AVTS", "ATEMPORAL", "PREMIUM", "CLASSIC", "FML"))
    With Worksheets(sh1.Name).UsedRange.Columns(3)
        Set c = .Find(what:="ALTA VISTA", LookIn:=xlValues, LookAt:=xlPart)
        If Not c Is Nothing Then
              frangmarcas .Cells(c.Row, c.Column - 2).Value, sh1.Name
        End If
    End With
Next sh1

End Sub

Sub frangmarcas(Marca As String, NomFeuille As String)
    Dim i2 As Byte

    With Worksheets("Resume")
            For i2 = 3 To 9
                    If .Cells(6, i2) = NomFeuille Then Exit For
            Next i2
            .Cells(13, i2) = Marca
    End With

End Sub

 

[Amauty]

Re : vba : eviter les recalculs automatiques, accélérer une macro

Merci Bebere,
j'ai juste eu à adapter le numéro de colonne de mes .cells( car il commençait à la colonne 3 du fait du with wsh...columns (3).
Maintenant je vais tenter d'appliquer ces apprentissages à une autre macro de mise en forme avant impression très lente. je risque de revenir avec quelques questions ! a
A bientôt

Amaury