Simplification d'un code

[richert90]

Bonjour,

En pièce jointe, un fichier avec un tableau sur lequel je me base pour créer des graphiques automatiquement. pour cela, je parcours les données du tableau. dans le première colonne j'ai des numéros de groupe (ici il y a 3 groupes mais on peut en avoir 2, 5 etc...) et je créer un graphique par groupe avec en abscisse la date et en ordonnées 2 paramètres (colonne E et F). Cela marche très bien sur le fichier que je vous ait joint. Mais le tableau est très petit (100lignes environ) et lorsque je travaille sur un tableau immense (70 000 lignes), la macro mais énormément de temps à sélectionner la plage de données du graphique. Je pense que ça vient du do..while qui met beaucoup du temps. Auriez-vous une solution?

J'ai essayer avec les ArrayList mais j'ai peu d’expérience et j'ai beaucoup de mal.

Merci d'avance,

 

[Robert]

Re : Simplification d'un code

Bonjour Richert, bonjour le forum,

Peut-être comme ça avec un filtre automatique :

Public Sub Graphs()
Dim O As Object 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire))
Dim I As Byte 'déclare la variable I (Incrément)
Dim PLV As Range 'déclare la variable PLV (PLage Visible)
Dim CR As Range 'déclare la variable CR (Cellule de Référence)

Set O = Sheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O
Set PL = O.Range("A2:A" & DL) 'définit la plage PL
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For Each CEL In PL 'boucle sur toutes les cellules CEL de la plage PL
    D(CEL.Value) = "" 'alimente le dictionnaire D
Next CEL 'prochaine cellule de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des éléments unique de la plage PL (asns doublon)
Set CR = Cells(2, 2) 'initialise la cellule de référence pour la hauteur du graphique CR
For I = 0 To UBound(TMP) 'boucle sur tous les éléments du tableau TMP
    O.Range("A1").AutoFilter Field:=1, Criteria1:=TMP(I) 'filtre la colonne 1 (=A) de l'onglet O avec TMP(I) comme critère (= groupe)
    Set PLV = PL.SpecialCells(xlCellTypeVisible).Resize(, 6) 'définit la plage PLV des cellules visibles de la plage PL redimensionnée à 6 colonnes
    Sheets(2).Select 'Selection du second onglet du classeur
    ActiveSheet.Shapes.AddChart.Select 'ajout d'un graphique
    ActiveChart.ChartType = xlXYScatter 'Type du graphique: ici nuage de points
    'source de données du graphique
    ActiveChart.SetSourceData Source:=Application.Union(Application.Intersect(O.Columns(2), PLV), Application.Intersect(O.Columns(5), PLV), Application.Intersect(O.Columns(6), PLV))
    With ActiveSheet.ChartObjects(I + 1) 'prend en compte le graphique
        .left = CR.left 'position gauche
        .Top = CR.Top 'position haute
        .Width = Range("B2:N20").Width 'largeur
        .Height = Range("B2:N20").Height 'hauteur
    End With 'fin de la prise en compte du graphique
    O.Range("A1").AutoFilter 'supprime le filtre automatique
    If CR.Column = 2 Then 'condition : si la colonne la cellule de référence est égale à 2
        Set CR = CR.Offset(0, 14) 'redéfinit la cellule de référence CR
    Else 'sinon
        Set CR = CR.Offset(20, -14) 'redéfinit la cellule de référence CR
    End If 'fin de la condition
Next I 'prochain groupe de la boucle
End Sub

 

[richert90]

Re : Simplification d'un code

Salut,
Merci pour ta réponse

J'ai donc comparé ton code au mien avec 100 000 lignes environ et bizarrement mon code s’exécute en 7 secondes et le tient en 9 secondes.

 

[Robert]

Re : Simplification d'un code

Bonjour le fil, bonjour le forum,

Je dirais que c'est normal le mien vient de Sète, il faut chaud, la cagne...

 

[richert90]

Re : Simplification d'un code

mdr.
Plus sérieusement, Y-a t-il en général une autre méthode que les do..wile plus rapide pour parcourir un grand nombre de lignes?

 

[camarchepas]

Re : Simplification d'un code

Bonjour Robert, Richert, les Ami(e)s du Forum

La méthode de recherche en tenailles peut être une solution :

Sub test()
Dim Compteur As Range


    Sheets(1).Select 'On se place feuille 1 où est le B.D.D
    
    For groupe = 1 To 3
    
        
        'On regarde où est la première ligne avec le numéro de groupe correspondant à la variable groupe
        Set Compteur = Sheets(1).Range("A:A").Find(groupe, lookat:=xlValue)
        If Not Compteur Is Nothing Then compteur_deb = Compteur.Row
       ' la derniere ligne
        Set Compteur = Sheets(1).Range("A:A").Find(groupe, SearchDirection:=xlPrevious, lookat:=xlValue)
        If Not Compteur Is Nothing Then compteur_fin = Compteur.Row
        
        'On a la plage de données: de compteur_deb à compteur_fin .
        Sheets(2).Select 'On se place feuille 3 où seront insérés les graphiques.
        
        'On insère le graphique:
            '1) On choisit les données

            ActiveSheet.Shapes.AddChart.Select
            ActiveChart.ChartType = xlXYScatter 'Type du graphique: ici nuage de points
            ActiveChart.SetSourceData Source:=Sheets(1).Range("B" & compteur_deb & ":B" & compteur_fin & ",E" & compteur_deb & ":E" & compteur_fin & ",F" & compteur_deb & ":F" & compteur_fin)

    
    
    
    
    
    
    If groupe = 1 Then
                With ActiveSheet.ChartObjects(groupe)
                    .Left = Range("B2:N20").Left
                    .Top = Range("B2:N20").Top
                    .Width = Range("B2:N20").Width
                    .Height = Range("B2:N20").Height
                End With
            Else
                If groupe = 2 Then
                    With ActiveSheet.ChartObjects(groupe)
                        .Left = Range("P2:AA20").Left
                        .Top = Range("P2:AA20").Top
                        .Width = Range("P2:AA20").Width
                        .Height = Range("P2:AA20").Height
                    End With
                Else
                    If groupe = 3 Then
                        With ActiveSheet.ChartObjects(groupe)
                            .Left = Range("B22:N40").Left
                            .Top = Range("B22:N40").Top
                            .Width = Range("B22:N40").Width
                            .Height = Range("B22:N40").Height
                        End With
                    End If
                End If
            End If
            
    Next groupe
End Sub

 

[Efgé]

Re : Simplification d'un code

Bonjour à tous

Pour jouer (lancer la macro par Alt+F8)

Cordialement

 

[Efgé]

Re : Simplification d'un code

Re
Le même, sans limitation du nombre de graphiques créés
Cordialement

EDIT : Avec les noms de séries c'est plus propre.

 

[richert90]

Re : Simplification d'un code

Bonjour,

Merci pour vos codes,
Il marchent bien et sont plus rapides que ce que j'avais proposé

 

[Efgé]

Re : Simplification d'un code

Bonjour à tous,

Une version améliorée, testée sur 10 graphiques de 1 000 lignes chacun en 0,08.
J'aimerais bien savoir en combien de temps il tourne sur 100 000 lignes.

Cordialement

 

[richert90]

Re : Simplification d'un code

Hello,
Efgé, j'ai testé ton fichier avec précisément 108 292 lignes. 3 graphiques sont crées en 0,8 secondes! Plutôt pas mal!
Je vais essayer d'utiliser celui-ci afin de rajouter quelques bricoles comme un titre aux axes, rajoute run 2ieme axe des ordonnées (car les 2 paramètres qu'ont tracent n'ont pas la même unité).