XL 2013 [Résolu] Optimisation VBA

[Spinzi]

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.

 

[Robert]

Bonjour Spinzi, bonjour le forum,

Peut-être comme ça :

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

 

[Spinzi]

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

 

[Robert]

Bonjour Spinzi, bonjour le forum,

Le calcul automatique est réactivé à la fin de la macro...

 

[Spinzi]

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