Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2013 [Résolu] Optimisation VBA

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion Spinzi
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire

Spinzi

XLDnaute Impliqué
Bonjour à tous,

dans un cadre professionnel, j'ai été amené à créer un "formulaire" qui permet aux opérationnels de remonter leurs besoins concernant certains de leurs budgets.
Via ce formulaire, qui se veut "friendly user", un opérationnel peut choisir d'effectuer :
_un transfert budgétaire (déplacer un budget sur un autre projet)
_une augmentation budgétaire (augmenter un budget sans contrepartie)
_une ouverture budgétaire (permettre aux opérationnel d'utiliser un budget correspondant à une année suivante - N+1 voire N+2)

Dans ce contexte, et malgré mes difficultés en VBA, j'ai pondu un code qui fonctionne, mais qui n'est pas optimisé je pense.

Ce formulaire fait appel à du VBA pour ce qui est de l'aspect mise en forme (masquer des lignes suivant les choix effectués) et des formules (en fonction des cellules sur lesquels on clic aux lignes 7 et 9, cela génère un numéro qui va conditionner les formules dans les pavés plus bas).

Le problème c'est que ce fichier n'est pas très lourd mais un petit peu lent à l'utilisation : pensez vous que le code soit optimisable ?

Merci de votre retour,

Spinzi

ps : j'ai supprimé mes feuilles utilisant des données confidentielles, il est donc normal que vous retrouviez des "#REF" dans les formules et dans le gestionnaire de noms.
 

Pièces jointes

Trier par date Trier par votes
Bonjour Spinzi, bonjour le forum,

Peut-être comme ça :
VB: 
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Application.DisplayAlerts = False
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Application.Intersect(Application.Union(Range("D7"), Range("F7"), Range("H7"), Range("D9"), Range("F9"), Range("H9")), Target) Is Nothing Then Exit Sub

If Not Intersect(Target, Range("D7")) Is Nothing And Target.Count = 1 Then
    Target = "¤"
    [F7] = "¡": [H7] = "¡": [H9] = "¡": [A1] = 1
    Rows("9:9").EntireRow.Hidden = False
    Rows("10:25").EntireRow.Hidden = False
    Rows("26:33").EntireRow.Hidden = False
    Rows("34:37").EntireRow.Hidden = True
    Rows("38:56").EntireRow.Hidden = True
End If

If Not Intersect(Target, Range("F7")) Is Nothing And Target.Count = 1 Then
    Target = "¤"
    [D7] = "¡": [H7] = "¡": [H9] = "": [A1] = 2
    Rows("9:9").EntireRow.Hidden = False
    Rows("10:25").EntireRow.Hidden = False
    Rows("26:33").EntireRow.Hidden = True
    Rows("34:37").EntireRow.Hidden = False
    Rows("38:56").EntireRow.Hidden = True
End If

If Not Intersect(Target, Range("H7")) Is Nothing And Target.Count = 1 Then
    Target = "¤"
    [F7] = "¡": [D7] = "¡": [H9] = "": [A1] = 3: [D9] = "¤": [F9] = "¡": [B1] = 1
    Rows("9:9").EntireRow.Hidden = True
    Rows("10:25").EntireRow.Hidden = False
    Rows("26:33").EntireRow.Hidden = True
    Rows("34:37").EntireRow.Hidden = False
    Rows("38:56").EntireRow.Hidden = True
End If

If Not Intersect(Target, Range("D9")) Is Nothing And Target.Count = 1 Then
    Target = "¤"
    If [D7] = "¤" Then
        [F9] = "¡": [H9] = "¡": [B1] = 1
        Rows("10:33").EntireRow.Hidden = False
        Rows("38:56").EntireRow.Hidden = True
    Else
        [F9] = "¡": [H9] = "": [B1] = 1
        Rows("10:25").EntireRow.Hidden = False
        Rows("34:37").EntireRow.Hidden = False
        Rows("38:56").EntireRow.Hidden = True
    End If
End If

If Not Intersect(Target, Range("F9")) Is Nothing And Target.Count = 1 Then
    Target = "¤"
    If [D7] = "¤" Then
        [D9] = "¡": [H9] = "¡": [B1] = 2
        Rows("10:25").EntireRow.Hidden = False
        Rows("38:56").EntireRow.Hidden = True
    Else
        [D9] = "¡": [H9] = "": [B1] = 2
        Rows("10:25").EntireRow.Hidden = False
        Rows("34:37").EntireRow.Hidden = False
        Rows("38:56").EntireRow.Hidden = True
    End If
End If

If Not Intersect(Target, Range("H9")) Is Nothing And Target.Count = 1 Then
    Target = "¤"
    [D9] = "¡": [F9] = "¡": [B1] = 3
    Rows("13:37").EntireRow.Hidden = True
    Rows("38:56").EntireRow.Hidden = False
End If

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
 
Vote positif 0 Vote négatif
Bonjour Robert,

merci pour ce code.
Je dois encore améliorer le mien mais je vais intégrer la partie ApplicationScreenUpdating.
Par contre je dois laisser le calcul automatique.

Bien à vous,

Spinzi
 
Vote positif 0 Vote négatif
Bonjour Robert,

Effectivement il est réactivé à la fin mais cela décale la mise à jour du fichier : tant que je n'ai pas appuyé de nouveau sur un choix, ca ne calcule pas.

Merci tout de même de vous être penché sur mon souci.

Voila la version finale terminée ce matin (en pj)

Spinzi
 

Pièces jointes

Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

A
  • Résolu(e)
Microsoft 365 [VBA] Macro pour automatiser une sortie
2 3
Réponses
37
Affichages
3 K
asso78Lim
A
A
  • Question Question
XL 2010 Recopie et Incrémentation
Réponses
1
Affichages
1 K
Dudu2
  • Question Question
XL 2016 VBA - Optimisation Code Array
Réponses
5
Affichages
1 K
Spinzi
C
  • Résolu(e)
XL 2013 VBA - Amélioration d'une macro consolidation
Réponses
8
Affichages
2 K
Genii
G
R
  • Question Question
Remplissage automatique de données après une validation de formulaire par VBA (Formules composées de plusieurs produits"
Réponses
3
Affichages
2 K
remy3434
R
  • Question Question
XL 2019 UserForm liste déroulante (cascade) avec ajout de données/modification
2 3
Réponses
38
Affichages
9 K
kinders59
T
  • Question Question
Microsoft 365 Procédure trop grande
Réponses
1
Affichages
1 K
ton-v
T
  • Question Question
XL 2010 [Résolu] Index Equiv en VBA
2 3 4
Réponses
46
Affichages
8 K
Spinzi
  • Question Question
XL 2010 [Résolu] Synthèse de plusieurs classeurs VBA
Réponses
3
Affichages
1 K
Spinzi
  • Question Question
XL 2010 [Résolu] Création nouveau classeur puis copie onglets VBA
Réponses
2
Affichages
2 K
Spinzi
S
  • Question Question
XL 2013 [Résolu] TCD - MFC - VBA: Bonnes pratiques
Réponses
2
Affichages
1 K
sarah33
S
B
  • Question Question
[Résolu] Planning, Fériés, Optimisation SOMMEPROD
Réponses
5
Affichages
1 K
Modeste geedee
M
  • Question Question
[VBA] Mise en forme et recopie de formules
Réponses
2
Affichages
1 K
Maxitos
M
I
  • Question Question
Formules / VBA ? Optimisation de recherches (plages dynamiques)
2
Réponses
16
Affichages
3 K
Int0x
I
D
  • Question Question
Planning enfin opérationnel !
Réponses
0
Affichages
2 K
dmoluc
D
Z
  • Question Question
calcul temps de travail ambulanciers (résolu): classeur.
Réponses
7
Affichages
14 K
Gizo
G
R
  • Question Question
VBA Excel : pb fermeture doc Word créé sur modèle depuis Excel VBA
Réponses
10
Affichages
3 K
PMO2
P
E
  • Question Question
Tableau croisé dynamique par macro
Réponses
13
Affichages
2 K
elouahi95
E
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…