Créer des courbes en fonction de leur intitulé de colonne

**Bwordan** · 03/08/2016, 11h26

Bonjour à tous,

Alors voilà je dois réaliser une macro qui a pour but de créer des graphiques avec des courbes filtrées en fonction de leur intitulé de colonne. En effet j'ai en entrée un tableur avec des mesures issues de test mais ce tableur d'entrée n'est pas formalisé.

Une fois il peut avoir tels intitulé de colonne et une autre fois cette colonne peut avoir un autre intitulé et l'intitulé d'avant une autre colonne (bien sur les données dans les colonnes suivent leurs intitulés).
J'ai cherché partout sans rien trouver, j'étais parti à la base sur tracer toutes les courbes puis supprimées celle dont je n’ai pas besoins mais je retombe toujours sur mon problème de savoir dans quelle colonne se situent telle donnée.

Merci d'avance pour votre aide

.

**eric4459** · 03/08/2016, 14h36

Bonjour Bwordan,
Essayes avec l'enregistreur de Macros et regardes ce que te donne le code, tu pourra en déduire le code recherché.
Postes le résultat obtenu entre balises comme ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Ton Code

si cela ne répond pas exactement à ce que tu recherches et expliques nous plus précisément.
Eric

**Bwordan** · 03/08/2016, 15h01

Je l'ai fais pour une seule courbe:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Macro4()
'
' Macro4 Macro
'
 
'
    Range("A:A,AK:AK").Select
    Range("AK1").Activate
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SetSourceData Source:=Range( _
        "'Data 8199 2391 7_29_2016 10 (2)'!$A:$A,'Data 8199 2391 7_29_2016 10 (2)'!$AK:$AK" _
        )
End Sub

Ici le problème c'est que le graphique est lié à la cellule et moi j'aimerai qu'il soit lié à la l'intitulé des colonnes (les légendes des courbes) car j'ai des donnée qui peuvent changé de place dans le tableur ca dépend du tableur d'entrée.

Sinon au début j'avais fais ca en supprimant tout ce dont je n'avais pas besoin :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Sheets("Timed_data").Select
    Charts.Add
    ActiveChart.SetSourceData Source:=Range("Timed_data!$A$1:$BI$404")
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.Legend.Select
    ActiveChart.SeriesCollection(1).Delete
    ActiveChart.SeriesCollection(59).Delete
    ActiveChart.SeriesCollection(58).Delete
    ActiveChart.SeriesCollection(57).Delete
    ActiveChart.SeriesCollection(56).Delete
    ActiveChart.SeriesCollection(55).Delete
    ActiveChart.SeriesCollection(54).Delete
    ActiveChart.SeriesCollection(53).Delete
    ActiveChart.SeriesCollection(52).Delete
    ActiveChart.SeriesCollection(51).Delete
    ActiveChart.SeriesCollection(50).Delete
    ActiveChart.SeriesCollection(49).Delete
    ActiveChart.SeriesCollection(48).Delete
    ActiveChart.SeriesCollection(47).Delete
    ActiveChart.SeriesCollection(46).Delete
    ActiveChart.SeriesCollection(45).Delete
    ActiveChart.SeriesCollection(44).Delete
    ActiveChart.SeriesCollection(43).Delete
    ActiveChart.SeriesCollection(42).Delete
    ActiveChart.SeriesCollection(41).Delete
    ActiveChart.SeriesCollection(40).Delete
    ActiveChart.SeriesCollection(39).Delete
    ActiveChart.SeriesCollection(38).Delete
    ActiveChart.SeriesCollection(37).Delete
    ActiveChart.SeriesCollection(36).Delete
    ActiveChart.SeriesCollection(35).Delete
    ActiveChart.SeriesCollection(34).Delete
    ActiveChart.SeriesCollection(33).Delete
    ActiveChart.SeriesCollection(32).Delete
    ActiveChart.SeriesCollection(31).Delete
    ActiveChart.SeriesCollection(30).Delete
    ActiveChart.SeriesCollection(29).Delete
    ActiveChart.SeriesCollection(28).Delete
    ActiveChart.SeriesCollection(27).Delete
    ActiveChart.SeriesCollection(26).Delete
    ActiveChart.SeriesCollection(25).Delete
    ActiveChart.SeriesCollection(24).Delete
    ActiveChart.SeriesCollection(23).Delete
    ActiveChart.SeriesCollection(22).Delete
    ActiveChart.SeriesCollection(21).Delete
    Sheets("Chart1").Name = "ThermistorsALL"

Mais c'est pareil l'ordre des séries peut changer.

Et après je me suis dis vu que j'ai la liste des intitulés des colonnes (légendes courbes, première ligne du tableau) je peux faire une fonction recherche dans le tableau avec cette liste en resortir la colonne de chaques intitulé et la réimplanter dans les options du graphique mais il ne prend pas les variables dans ses option.

**eric4459** · 03/08/2016, 15h03

Rebonjour,
Voici un morceau de code que j'ai déjà utilisé, tu verra que j'ai "forcé" le nom de mes séries, mais tu pourrais utiliser des variables à la place, jettes-y un oeil et reviens vers nous si besoin

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Sub Curve()
 
            Dim Curve As Worksheet
            Set Curve = ThisWorkbook.Sheets("Curve")
            Dim Grph As ChartObjects
            Dim Emplacement As Range
            Dim G As Integer
            Set Grph = Curve.ChartObjects()
            Set Emplacement = Range("B2:P38")
            Set Emplacement = Range("B2:P38")
 
 
            Curve.Select
            G = ActiveSheet.ChartObjects.Count
            If G > 0 Then
            ActiveSheet.ChartObjects(G).Delete
            End If
            ActiveSheet.Shapes.AddChart.Select
            ActiveChart.ChartType = xlLine
            ActiveChart.SeriesCollection.NewSeries
            ActiveChart.SeriesCollection(1).Name = "=""Cum. Planned"""
            ActiveChart.SeriesCollection(1).Values = "=Main!$H$11:$BZ$11"
            ActiveChart.SeriesCollection(1).XValues = "=Main!$H$1:$BZ$1"
            ActiveChart.SeriesCollection.NewSeries
            ActiveChart.SeriesCollection(2).Name = "=""Cum. Actual"""
            ActiveChart.SeriesCollection(2).Values = "=Main!$H$21:$BZ$21"
            ActiveChart.SeriesCollection.NewSeries
            ActiveChart.SeriesCollection(3).Name = "=""Planned"""
            ActiveChart.SeriesCollection(3).Values = "=Main!$H$10:$BZ$10"
            ActiveChart.SeriesCollection(3).AxisGroup = 2
            ActiveChart.SeriesCollection.NewSeries
            ActiveChart.SeriesCollection(4).Name = "=""Actual"""
            ActiveChart.SeriesCollection(4).Values = "=Main!$H$20:$BZ$20"
            ActiveChart.SeriesCollection(4).AxisGroup = 2
            ActiveChart.Axes(xlValue).Select
            ActiveChart.Axes(xlValue).MaximumScale = 1
            ActiveChart.ChartGroups(2).GapWidth = 0
            ActiveChart.SeriesCollection(3).ChartType = xlColumnClustered
            ActiveChart.SeriesCollection(4).ChartType = xlColumnClustered
            'ActiveChart.SeriesCollection(6).ChartType = xlColumnClustered
            ActiveChart.Axes(xlCategory).TickLabels.NumberFormat = "[$-409]mmm-yy;@"
 
            With Grph
            .Left = Emplacement.Left
            .Top = Emplacement.Top
            .Height = Emplacement.Height
            .Width = Emplacement.Width
            End With
 
 
End Sub

J'espère que cela pourra t'aider ou t'aiguiller

Eric

**Bwordan** · 03/08/2016, 16h10

Rebonjour,

Alors j'ai réussi à advancer avec ce que tu m'as donné mais je suis retombé sur un problème voici le code que j'ai réalisé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub Curve()
 
Dim x As Range
Dim y As Range
 
    Set b = Cells.Find("c", , xlValues, xlPart, , , False)
    MsgBox b.Column
 
    Set d = Cells.Find("a", , xlValues, xlPart, , , False)
    MsgBox d.Column
 
Set x = b.Column
Set y = d.Column
 
 
    Charts.Add
 
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "=""Cum. Planned"""
    ActiveChart.SeriesCollection(1).Values = x
    ActiveChart.SeriesCollection(1).XValues = y
 
 
End Sub

Voici le tableau de données utilisé:

a	c
0	0
1	2
2	4
3	6
4	8
5	10
8	16

Le problème vient du liens entre le resultats du "Find" et des paramètre du graph mais je vois pas comment régler le problème...

J'avais pensé à directement mettre le numéro de colonne dans les paramètres du graph mais ca ne marche pas non plus.

**eric4459** · 03/08/2016, 17h06

Bwordan,
Pourrais-tu mettre ton fichier en pièce jointe ça aidera.
Eric

**Bwordan** · 03/08/2016, 17h40

Bon j'en suis arrivé à ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub Curve()
 
Dim x As Range
Dim y As Range
 
Set b = Cells.Find("c", , xlValues, xlPart, , , False)
    MsgBox b.Address
 
Set d = Cells.Find("a", , xlValues, xlPart, , , False)
    MsgBox d.Address
 
Set x = Range(b.Address).EntireColumn
Set y = Range(d.Address).EntireColumn
 
 
    Charts.Add
 
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "=""Cum. Planned"""
    ActiveChart.SeriesCollection(1).Values = x
    ActiveChart.SeriesCollection(1).XValues = y
 
 
End Sub

Mais j'aimerai qu'il ne trace pas la première ligne.

Voilà et encore merci pour l'aide que tu me fournis.

**eric4459** · 03/08/2016, 17h57

Désolé, je ne parviens pas à télécharger le fichier

**Bwordan** · 03/08/2016, 19h25

Bizarre ce me fait la même chose la page charge sur une page blanche :/. Sinon le code de la macro est celui utilisé juste au dessus et les donnée d'entrées c'est le tableau que j'ai mis plus haut car j'ai réessayé de renvoyé la pièce jointes mais elle me renvoie encore sur une page blanche désolé :/.

**Bwordan** · 04/08/2016, 09h51

Ca y est j'ai reussi

voici le code finale:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Curve()
 
Dim x As Range
Dim y As Range
 
Set b = Cells.Find("x", , xlValues, xlPart, , , False)
    MsgBox b.Address
 
Set d = Cells.Find("y", , xlValues, xlPart, , , False)
    MsgBox d.Address
 
Set x = Range(Cells(2, b.Column), Cells(20000, b.Column))
Set y = Range(Cells(2, d.Column), Cells(20000, d.Column))
 
    Charts.Add
 
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).Name = "=""Cum. Planned"""
    ActiveChart.SeriesCollection(1).Values = y
    ActiveChart.SeriesCollection(1).XValues = x

Bon le "cells(2000,d.columns)" ne me plait pas trop mais bon en attendant ca fonctionne.

Merci encore pour ton aide

, si tu vois une autre méthode que ce "cells(2000,d.columns)" pour choisir toute une colonne excepté la première ligne je suis preneur.

**eric4459** · 04/08/2016, 10h27

Bonjour,
Il semble que tu utilises "20000" pour être certain que tu prendras toutes les valeurs de tes colonnes.
Si c'est bien ton objectif, il suffit de compter le nombre de lignes non vide comme ceci par exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
Dim Nbline1, NbLine2 as Integer
With Nom de la Feuille 'Cela peut-etre "Feuil1" ou autre chose si tu as renommé ta feuille
    NbLine1 = .Cells(.Rows.Count, 2).End(xlUp).Row  ' Compte le nombre de ligne de la colonne B (2eme colonne)
    NbLine2 = .Cells(.Rows.Count, 4).End(xlUp).Row  ' Compte le nombre de ligne de la colonne D (4eme colonne)
End With
Set x = Range(Cells(2, b.Column), Cells(NbLine1, b.Column))
Set y = Range(Cells(2, d.Column), Cells(NbLine2, d.Column))

Dis moi si cela te convient
Eric

**Bwordan** · 04/08/2016, 10h41

Ca marche nickel un grand merci à toi Eric

.

Créer des courbes en fonction de leur intitulé de colonne [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager