macro trop lourde...

S

sterf

XLDnaute Nouveau
Bonjour,
comme indiqué dans l'intitulé, je me trouve face à un problème de "lourdeur" de macro. La macro concernée vérifie la valeur d'une série de cellule, si la valeur d'une de ces cellules est "1" elle appel l’exécution d'une autre macro puis RAZ cette même cellule.
EX:
If Range("CT29") = 1 Then
Call msp7Xdessouscible
Range("CT29").ClearContents
End If
If Range("CT39") = 1 Then
Call msp7Xdessuscible
Range("CT39").ClearContents
End If
If Range("CT49") = 1 Then
Call msp7Xdescendant
Range("CT49").ClearContents
End If
If Range("CT59") = 1 Then
Call msp7Xmontant
Range("CT59").ClearContents
End If
If Range("CU29") = 1 Then
Call msp7Xdessouscible
Range("CU29").ClearContents
End If
If Range("CU39") = 1 Then
Call msp7Xdessuscible
Range("CU39").ClearContents
End If
If Range("CU49") = 1 Then
Call msp7Xdescendant
Range("CU49").ClearContents
End If
If Range("CU59") = 1 Then
Call msp7Xmontant
Range("CU59").ClearContents
End If
etc...etc...

Le problème est que, comme vous pouvez le voir, ces codes ne traitent que 2 colonnes de cellules alors que mon tableau en comporte 90(je vous laisse faire le calcul...). Je reste persuadé qu'il y a possibilité de "compacter" ce code mais je ne sais pas comment m'y prendre...je me suis renseigné sur le système de "boucle" mais je n'ai réussi à le transposer à mon problème. Je me tourne donc une nouvelle fois vers vous et votre savoir.
Veuillez trouver en PJ une copie "allégé" de mon d'origine
La macro ce trouve dans le code de la feuille "avril"

merci par avance
 
Trier par date Trier par votes
Patrice33740

Patrice33740

XLDnaute Impliqué
Re : macro trop lourde...

Bonjour,

pour 90 colonnes commençant à la colonne 98 ("CT"); essaies ce code :
Code: 
Dim n°C As Long

For n°C = 98 To 98 + 90
     If Cells(29, n°C) = 1 Then
         Call msp7Xdessouscible
         Cells(29, n°C).ClearContents
     End If
     If Cells(39, n°C) = 1 Then
         Call msp7Xdessuscible
         Cells(39, n°C).ClearContents
     End If
     If Cells(49, n°C) = 1 Then
         Call msp7Xdescendant
         Cells(49, n°C).ClearContents
     End If
     If Cells(59, n°C) = 1 Then
         Call msp7Xmontant
         Cells(59, n°C).ClearContents
     End If
Next n°C
 
Vote positif 0 Vote négatif
H

Herdet

Nous a quitté
Repose en paix
Re : macro trop lourde...

Bonjour,
sterf
Le plus simple est de créer 3 tableaux pour les Cellules,Valeurs, et Noms de macros et d'utiliser une boucle avec un Run.
Code: 
Sub Test_macros()
   'T_Cellules  T_Valeurs   T_Macros
   For i = 1 To Range("T_Cellules").Rows.Count
      If Range("T_Valeurs")(i) = 1 Then
         T = Range("T_Macros")(i)
         Application.Run T
      End If
   Next
End Sub

Voir le fichier joint avec le code VBA à adapter.
Tu peux augmenter la taille des tableaux autant que nécessaire.

Cordialement
Robert
 

Pièces jointes

  • XLD-sterf-macro.xlsm
    18.7 KB · Affichages: 31
Dernière édition:
Vote positif 0 Vote négatif
H

Herdet

Nous a quitté
Repose en paix
Re : macro trop lourde...

Oups ! Correctif pour ClearContents oublié.

Code: 
Sub Test_macros()
   'T_Cellules  T_Valeurs   T_Macros
   Application.ScreenUpdating = False
   For i = 1 To Range("T_Cellules").Rows.Count
      If Range("T_Valeurs")(i) = 1 Then
         T = Range("T_Macros")(i)
         Application.Run T
         Range(Range("T_Cellules")(i)).ClearContents
      End If
   Next
End Sub
Sub msp7Xdessouscible()
   MsgBox "Macro : msp7Xdessouscible"
End Sub
Sub msp7Xdessuscible()
   MsgBox "Macro : msp7Xdessuscible"
End Sub
Sub msp7Xdescendant()
   MsgBox "Macro : msp7Xdescendant"
End Sub
Sub msp7Xmontant()
   MsgBox "Macro : msp7Xmontant"
End Sub
 

Pièces jointes

  • XLD-sterf-macro-V2.xlsm
    18 KB · Affichages: 30
Vote positif 0 Vote négatif
eriiic

eriiic

XLDnaute Barbatruc
Re : macro trop lourde...

Bonjour,

Autre proposition sélectionnant et nommant tes cellules 'ta_plage' sur la feuille :
Code: 
Dim c As Range
For Each c In [ta_plage]
    If c = 1 Then
        Select Case c.Row
        Case 29
            msp7Xdessouscible
        Case 39
            msp7Xdessuscible
        Case 49
            msp7Xdescendant
        Case 59
            msp7Xmontant
        End Select
        c.ClearContents
    Next c
End If
Si ta feuille évolue tu as juste le nom à reprendre.

eric
 
Vote positif 0 Vote négatif
H

Herdet

Nous a quitté
Repose en paix
Re : macro trop lourde...

eriiiic à dit:
Bonjour,

Autre proposition sélectionnant et nommant tes cellules 'ta_plage' sur la feuille :
Code: 
Dim c As Range
For Each c In [ta_plage]
    If c = 1 Then
        Select Case c.Row
        Case 29
            msp7Xdessouscible
        Case 39
            msp7Xdessuscible
        Case 49
            msp7Xdescendant
        Case 59
            msp7Xmontant
        End Select
        c.ClearContents
    Next c
End If
Si ta feuille évolue tu as juste le nom à reprendre.

eric
Cliquez pour agrandir...
If c = 1 Then...
Un risque quand même s'il y a dans "la plage" d'autres cellules avec des 1 mais hors liste.
Je pense qu'il est souhaitable de bien maitriser les références des cellules concernées mais sans fichier exemple, c'est difficile de le tester.
De plus si la liste s'agrandit avec d'autres lignes, il faudra à chaque fois modifier le code VBA pour l'adapter.

A+
Robert
 
Dernière édition:
Vote positif 0 Vote négatif
S

sterf

XLDnaute Nouveau
Re : macro trop lourde...

Salut à vous tous, je tiens tout d'abord à vous remercier pour votre aide rapide.. vraiment super cool....
je vais essayer de décrypter vos propositions (à première vue ça a l'air chaud :confused:, je teste tous ça demain)

j'ai réussi à partir d'un fichier précédent et plus petit à extraire une feuille...le tableau ne comporte que 43 colonnes mais la logique est identique. Le code est dans la feuille "Private Sub Worksheet_Calculate()" -> les références de cellules changent par rapport à celles énoncées plus haut: les colonnes "CT29;39;49;59 jusqu’à GE29;39;49;59" deviens "BA26;36;46;56" jusqu'à "CN26;36;46;56" je pense que la transposition avec un tableau plus gros sera à ma portée
encore merci à vous tous :eek:
 

Pièces jointes

  • macropatate.xlsm
    861.8 KB · Affichages: 55
Vote positif 0 Vote négatif
eriiic

eriiic

XLDnaute Barbatruc
Re : macro trop lourde...

Bonjour,

@Herdet
If c = 1 Then...Un risque quand même s'il y a dans "la plage" d'autres cellules avec des 1 mais hors liste.
Je pense qu'il est souhaitable de bien maitriser les références des cellules concernées mais sans fichier exemple, c'est difficile de le tester.
Cliquez pour agrandir...
Je ne comprend pas bien.
ma_liste est la sélection des cellules concernées. Comment pourraient-elles être 'hors liste' ?
Si on préfère on peut mettre en dur la plage dans le code.
L'idée c'était surtout Select Case sur le n° de ligne.
De plus si la liste s'agrandit avec d'autres lignes, il faudra à chaque fois modifier le code VBA pour l'adapter.
Cliquez pour agrandir...
Si tu fais le choix de mettre la plage en dur dans le code oui, comme dans les autres propositions. Sinon il y a juste à complèter la définition du nom.
Ou alors qq chose m'échappe encore (?) Possible...
eric
 
Vote positif 0 Vote négatif
H

Herdet

Nous a quitté
Repose en paix
Re : macro trop lourde...

Bonjour,
sterf
Solution adaptée à partir de celle de eriiic , à tester pas à pas bien sûr :

Code: 
Sub eriiic_Herdet_solution()
   
   Dim c As Variant
   For Each c In Range("$BA$26:$CN$56")      ' plage minimum
      If Not IsError(c.Value) Then
      Debug.Print c.Row & vbTab & c.Value
         If c = 1 Then
            Select Case c.Row
               Case 26:
                  msp7XdessouscibleC600
                  c.ClearContents
               Case 36
                  msp7XdescendantC600
                  c.ClearContents
               Case 46
                  msp7XdessuscibleC600
                  c.ClearContents
               Case 56
                  msp7XmontantC600
                  c.ClearContents
            End Select
         End If
      End If
   Next c
End Sub

eriiic
C'était dans le cas de plages discontinues mais pour une plage continue BA à CN c'est OK

A+
Robert
 
Dernière édition:
Vote positif 0 Vote négatif
H

Herdet

Nous a quitté
Repose en paix
Re : macro trop lourde...

Bonjour,
Bien vu Patrice33740. Je n'avais pas testé ( une autre priorité )
Le problème est bien plus compliqué dans le fichier car il y a des valeurs d'erreurs dans la feuille et une macro qui envoie des Email d'alerte et empêche d'écraser des formules par une valeur !:(

sterf
Nouveau code testé avec des 1 forcés à la place des formules ( corrigé aussi dans le post #10 )
Code: 
Sub eriiic_Herdet_solution()
   
   Dim c As Variant
   For Each c In Range("$BA$26:$CN$56")      ' plage minimum
      If Not IsError(c.Value) Then
'Debug.Print c.Row & vbTab & c.Value
         If c = 1 Then
            Select Case c.Row
               Case 26:
                  msp7XdessouscibleC600
                  c.ClearContents
               Case 36
                  msp7XdescendantC600
                  c.ClearContents
               Case 46
                  msp7XdessuscibleC600
                  c.ClearContents
               Case 56
                  msp7XmontantC600
                  c.ClearContents
            End Select
         End If
      End If
   Next c
End Sub

A+
Robert
 
Vote positif 0 Vote négatif
T

Theze

XLDnaute Occasionnel
Re : macro trop lourde...

Bonsoir,

Et avec une boucle ?
Code: 
Sub Test()

    Dim I As Integer
    
    For I = 29 To 59 Step 10
    
        If Range("CT" & I) = 1 Then
        
            msp7Xdessouscible
            Range("CT" & I).ClearContents
            
        End If
        
        If Range("CU" & I) = 1 Then
        
            msp7Xdessouscible
            Range("CU" & I).ClearContents
            
        End If
        
    Next I

End Sub

Hervé.
 
Vote positif 0 Vote négatif
Patrice33740

Patrice33740

XLDnaute Impliqué
Re : macro trop lourde...

Theze à dit:
Bonsoir,

Et avec une boucle ?
Code: 
Sub Test()

    Dim I As Integer
    
    For I = 29 To 59 Step 10
    
        If Range("CT" & I) = 1 Then
        
            msp7Xdessouscible
            Range("CT" & I).ClearContents
            
        End If
        
        If Range("CU" & I) = 1 Then
        
            msp7Xdessouscible
            Range("CU" & I).ClearContents
            
        End If
        
    Next I

End Sub

Hervé.
Cliquez pour agrandir...
Tu n'as pas bien lu le fil, à chaque ligne une sub différente et c'est sur les colonnes qu'il faut boucler !!!!
 
Vote positif 0 Vote négatif
S

sterf

XLDnaute Nouveau
Re : macro trop lourde...

Bonjour messieurs dames,
j'ai grace à vous la solution à mon problème (solution du post n°12 ), je vous remercie tous pour avoir participés à la résolution de mon problème. La difference de taille "avant après" est juste impréssionnante. Mon seul regret est de ne pas avoir compris toutes les étapes de cette macro, ce qui m'aurait permis d'alléger un peu plus mon fichier...

En espérant un jour peu être vous rendre la pareille (en même tps vue mon niveau ç'est pas demain la veille)

Changez rien...vous ètes déja au top :cool:...

Sterf
 
Vote positif 0 Vote négatif

Discussions similaires

yojema
  • Question
XL 2021 faire évoluer un code VBA
Réponses
3
Affichages
209
Dranreb
Dranreb
chaelie2015
  • Question
XL 2013 Réduire un code
Réponses
0
Affichages
269
chaelie2015
chaelie2015
piga25
  • Résolu(e)
XL 2016 Gestion d'erreur dans code
Réponses
6
Affichages
252
piga25
piga25
M
  • Question
Microsoft 365 modifier un code
Réponses
1
Affichages
267
Dranreb
Dranreb
D
  • Question
XL 2021 VBA - Erreur 1004 aléatoire - Image/Logo
Réponses
10
Affichages
416
crocrocro
C
Regueiro
  • Question
Microsoft 365 Format Nombre Combobox dans Feuille
Réponses
3
Affichages
211
fanch55
fanch55
A
  • Question
Microsoft 365 Code VBA Envoi contenu tableau Excel par Email
Réponses
1
Affichages
146
Phil69970
Phil69970
P
  • Résolu(e)
Autres Macro trop longue
Réponses
6
Affichages
380
TooFatBoy
TooFatBoy
R
  • Question
XL 2016 excel 2016 VBA
Réponses
2
Affichages
182
rebatte
R
C
  • Résolu(e)
XL 2021 Remplir données devis en vba avec descriptions/quantités/PUs alignés
2
Réponses
18
Affichages
570
Phil69970
Phil69970

Membres actuellement en ligne

11 membres et 133 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 501
Messages
2 089 014
Membres
104 005
dernier inscrit
Maxence