Optimisation du code VBA (graphiques) pour un temps d'éxécution + rapide.

[richert90]

Bonjour à toutes et à tous,

Je fais appel à vous pour un petit problème. En effet j'ai un tableau sous Excel qui contient beaucoup de lignes (environ 400 000) et à partir de celui-ci je dois faire des nuages de points : 1 graphique pour chaque "Groupe" (dans le fichier joint j'ai 3 groupes donc 3 graphiques). Le code que j'ai marche très bien mais il est très long à exécuter (compter 2 minutes....).
Est-ce qu'on peut optimiser le code pour générer les graphiques afin de gagner du temps?

Merci d'avance,

PS: Je ne peux pas joindre le fichier complet car il est trop lourd (13000 Ko), du coup je vous joins un extrait de la base de données (avec seulement 25000 lignes au lieu des 400 000) et le code pour générer les graphiques. . A l'ouverture du fichier, il n'y a aucun graphique, cela est fait exprès pour que vous puissiez bien voir le temps que met Excel lorsque vous exécuterez le programme "graph_per_group".
Pour que le test soit réel vous pouvez essayer avec les 400 000 lignes environ pour voir.

Merci d'avance de votre aide;

 

[PMO2]

Re : Optimisation du code VBA (graphiques) pour un temps d'éxécution + rapide.

On pourrait obtenir un gain de temps significatif
1) en utilisant des variables objet
2) en travaillant toutes les données en mémoire

Bonsoir,

Voilà un premier jet.

Const FEUILLE_DATA As String = "Feuil2"

Type structGroupe
  LigDeb As Long
  LigFin As Long
  Item As Long
End Type

Sub aa()
Dim Groupe() As structGroupe
Dim S As Worksheet
Dim CH As Chart
Dim SC As Series
Dim LG As Legend
Dim Position As Range
Dim R As Range
Dim var As Variant
Dim LastGroup&
Dim Lig&
Dim varGroupe
Dim i&
Dim cpt&

'### Les données ###
Set S = Sheets(FEUILLE_DATA)
Set R = S.[a1].CurrentRegion.Offset(1, 0)
var = R
'---
Lig& = 2
varGroupe = 1
For i& = 1 To UBound(var, 1)
  If var(i&, 1) <> varGroupe Then
    cpt& = cpt& + 1
    ReDim Preserve Groupe(1 To cpt&)
    With Groupe(cpt&)
      .Item = varGroupe
      .LigDeb = Lig&
      .LigFin = i&
    End With
    varGroupe = varGroupe + 1
    Lig& = i& + 1
  End If
Next i&

'#### Les graphiques ###
Set S = Sheets.Add(after:=Sheets(Sheets.Count))
Set Position = S.[b2]

For i& = 1 To cpt&
  S.Shapes.AddChart(xlXYScatterSmooth, Position.Left, Position.Top, Application.CentimetersToPoints(24.89), Application.CentimetersToPoints(9.91)).Select
  Set CH = Selection.Parent
  
  '--- Position du graphique ---
  If i& Mod 2 = 0 Then
    Set Position = Position.Offset(20, -12)
  Else
    Set Position = Position.Offset(0, 12)
  End If
  
  'On ajoute la série des valeurs "Value":
  Set SC = CH.SeriesCollection.NewSeries
  SC.Name = "=Feuil2!$E$1" 'Nom de la série qu'on retrouvera dans la légende
  SC.XValues = "=Feuil2!$D$" & Groupe(i&).LigDeb & ":$D$" & Groupe(i&).LigFin 'Valeurs en abscisses: les dates + heures qu'on trouve en colonne D
  SC.Values = "=Feuil2!$E$" & Groupe(i&).LigDeb & ":$E$" & Groupe(i&).LigFin  'Valeurs en ordonnées: la T°: colonne E
  
  'On ajoute la série "Max Value":
  Set SC = CH.SeriesCollection.NewSeries
  SC.Name = "=Feuil2!$F$1"
  SC.XValues = "=Feuil2!$D$" & Groupe(i&).LigDeb & ":$D$" & Groupe(i&).LigFin
  SC.Values = "=Feuil2!$F$" & Groupe(i&).LigDeb & ":$F$" & Groupe(i&).LigFin  'Valeurs en ordonnées: la T° MAX: colonne F
  SC.MarkerStyle = 8 'Type de marqueur = points
  SC.MarkerSize = 2 'Taille marqueurs
  SC.Format.Line.Weight = 1
  
  '2) on rajoute un cadre autour de la légende
  Set LG = CH.Legend
  LG.Border.Color = vbBlack
  
  '3) On insère un titre sur le graphique
  CH.HasTitle = True
  With CH.ChartTitle
    .Text = "Evolution temperature of the lighting (Group" & i& & ")"
    .Characters.Font.Size = 14
  End With
  
  '4) On ajoute un titre à l'axe des abscisses:
  With CH.Axes(xlCategory)
    .HasTitle = True
    With .AxisTitle
      .Caption = "Inspection time"
      .Font.Size = 10
    End With
  End With
  
  '5) on ajoute un titre à l'axe des ordonnées
  With CH.Axes(xlValue)
    .HasTitle = True
    With .AxisTitle
      .Caption = "Temperature values (degree celsius)"
      .Font.Size = 10
    End With
  End With
Next i&
End Sub

Est-ce mieux ?

 

[richert90]

Re : Optimisation du code VBA (graphiques) pour un temps d'éxécution + rapide.

Re,

Merci pour ton aide encore,

J'essaye ça dès demain matin, je vous retiens au courant
En espérant que la durée d'exécution sera plus rapide

 

[richert90]

Re : Optimisation du code VBA (graphiques) pour un temps d'éxécution + rapide.

Bonjour à tous,

Alors j'ai fais le test du code ci-dessus et c'était plutôt une bonne surprise, au lieu des 3 minutes pour ouvrir le fichier, on est passé a 1 minutes à peine, ce qui est donc déjà pas mal . Merci donc à PM02 pour cet aide

 

[PMO2]

Re : Optimisation du code VBA (graphiques) pour un temps d'éxécution + rapide.

Bonjour,

Les instructions (signalées par '///ajout) devraient permettre un gain de temps supplémentaire.

'#### Les graphiques ###
Application.ScreenUpdating = False    '///ajout
Set S = Sheets.Add(after:=Sheets(Sheets.Count))
Set Position = S.[b2]

'...

  '5) on ajoute un titre à l'axe des ordonnées
  With CH.Axes(xlValue)
    .HasTitle = True
    With .AxisTitle
      .Caption = "Temperature values (degree celsius)"
      .Font.Size = 10
    End With
  End With
Next i&
Application.ScreenUpdating = True    '///ajout
End Sub

 

[richert90]

Re : Optimisation du code VBA (graphiques) pour un temps d'éxécution + rapide.

Peut on aussi rajouter cette instruction pour gagner encore du temps

Application.Calculation=xlCalculationManual

?

 

[richert90]

Re : Optimisation du code VBA (graphiques) pour un temps d'éxécution + rapide.

Re,
J'ai encore un petit problème
En voulant appliquer des filtrers sur le tableau de l'onglet 2, les graphiques ne se mettent pas à jours alors que normalement ça se fait avec Excel?
Sauriez-vous d'où cela vient ?

Merci d'avance

 

[debidebo67]

Re : Optimisation du code VBA (graphiques) pour un temps d'éxécution + rapide.

au début de ton code :

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

à la fin de ton code (avant end sub)

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

c'est le minimum pour faire aller une macro beaucoup plus vite

 

[richert90]

Re : Optimisation du code VBA (graphiques) pour un temps d'éxécution + rapide.

Oui Oui c'est ce que j'ai fais.
Mais du coup comment ça se fait que les filtres appliqués aux données ne se voient pas sur les graphiques (qui y font références pourtant..) ?

En fait si je fais d'abord des filtres sur la base , PUIS que je lance le programme pour générer les graphiques: dans ce cas, les graphiques prennent bien en compte les filtres.
Mais si je fais d'abord les graphiques et que je veux ensuite filtrer des valeurs (et donc voir le graphique se mettre à jour en fonction des filtres que j'ai choisit), le graphique ne se met pas à jour.. je ne sais pas pourquoi, peut-être que cela vient de l'utilisation de variables objets?.. Dans ce cas une solution serait de supprime l'onglet graphique puis de relancer le programme pour créer des graphiques après chaque filtre.. mais bon ce serait un gros traitement alors que normalement les filtres mettent à jour le graphique directement...

Merci d'avance de m'aider,