Graphique nuage de points - VBA

[knaekes]

Bonjour,

je souhaite créer un graphique type nuage de points à partir de données non stockées dans les cellules des feuilles excel.

En utilisant l'enregistreur de macro, je parviens à créer un graphique. Cependant:
1. les données en abcisse ne correspondent pas aux dates voulues.
2. le report sur l'axe des abscisses n'est pas proportionnel.

Comment corriger ces 2 points?

Merci pour votre aide.

Ci-joint le fichier

 

[Dranreb]

Re : Graphique nuage de points - VBA

Bonjour
J'ai réussi comme ça :

ActiveChart.SeriesCollection(1).XValues = "={" & CLng(#3/1/2011#) & "," & CLng(#3/10/2011#) & "," & CLng(#3/12/2011#) & "}"
    ActiveChart.SeriesCollection(1).Values = "={5,9,3}"
    ActiveChart.Axes(xlCategory).TickLabels.NumberFormat = "m/d/yyyy"

Pour trouver ça j'ai commencé par mettre les dates dans une plage, que j'ai indiqué comme valeurs x, puis j'ai resélectionné dans la formule ce paramètre, touche F9. J'ai vu qu'il rendait en constantes entières les valeurs des dates.
À +

 

[kjin]

Re : Graphique nuage de points - VBA

Bonjour,
Avec un type de graphique différent

Sub essai()
Dim tb1, tb2, cht As Object, ser As Series
tb1 = Array("3/1/2011", "3/10/2011", "3/12/2011")
tb2 = Array(5, 9, 3)
Set cht = ActiveSheet.ChartObjects.Add(150, 50, 400, 250)
With cht.Chart
    Set ser = .SeriesCollection.NewSeries
    With ser
        .Name = "Evolution"
        .XValues = tb1
        .Values = tb2
    End With
    .ChartType = xlLineMarkers
End With
End Sub

A+
kjin

 

[knaekes]

Re : Graphique nuage de points - VBA

Merci pour vos réponses

Toutefois cela se complique lorsque j'essaie de transposer vos propositions à mon cas de figure.

Ci-joint le lien et le fichier correspondant à mon cas de figure. Robert (voir lien) m'a fourni un fichier excel bien détaillé pour parvenir jusqu'à ce point, mais sans réussir à y faire figurer les dates (et les écarts proportionnels) sur l'axe des abscisses.

https://www.excel-downloads.com/threads/tableau-de-variables-vba.165233/

Est-il possible d'adapter vos solutions à mon cas de figure ?

 

[Dranreb]

Re : Graphique nuage de points - VBA

En mettant .ChartType = xlXYScatterLines et en déclarant Tba() As Long au lieu de As Date, mais il faut glisser quelque part le .Axes(xlCategory).TickLabels.NumberFormat = "m/d/yyyy" pour qu'il continue d'afficher des dates.
À +

 

[kjin]

Re : Graphique nuage de points - VBA

Re,
Pas sûr d'avoir compris qq chose

Option Base 1
Sub Macro1()
Dim tabD, tabPlus, tabMoins, tabCumul
Dim rng As Range, min&, max&
Dim cht As Object, ser As Series
Set rng = Range("B5:C26")
min = Application.min(rng)
max = Application.max(rng)
ReDim tabD(max - min + 1)
ReDim tabPlus(max - min + 1)
ReDim tabMoins(max - min + 1)
ReDim tabCumul(max - min + 1)
For i = min To max
    x = x + 1
    tabD(x) = i
    tabPlus(x) = Application.CountIf(rng.Columns(1), "<=" & i)
    tabMoins(x) = Application.CountIf(rng.Columns(2), "<=" & i)
    tabCumul(x) = tabPlus(x) - tabMoins(x)
Next
Set cht = ActiveSheet.ChartObjects.Add(300, 50, 400, 250)
With cht.Chart
    Set ser = .SeriesCollection.NewSeries
    With ser
        .Name = "Cumul"
        .XValues = tabD
        .Values = tabCumul
        .Border.ColorIndex = 5
    End With
    Set ser = .SeriesCollection.NewSeries
    With ser
        .Name = "Ajouts"
        .Values = tabPlus
        .Border.ColorIndex = 10
    End With
    Set ser = .SeriesCollection.NewSeries
    With ser
        .Name = "Suppressions"
        .Values = tabMoins
        .Border.ColorIndex = 3
    End With
    .ChartType = xlLine
    .Legend.Position = xlBottom
    .PlotArea.Interior.ColorIndex = xlNone
    .PlotArea.Border.LineStyle = xlNone
    With .Axes(xlCategory)
        .TickLabels.NumberFormat = "dd/mm/yyyy"
        .TickLabels.Font.Size = 8
        .CrossesAt = 1
        .TickLabelSpacing = 1
        .TickMarkSpacing = 1
    End With
    With .Axes(xlValue)
        .MinimumScale = Application.min(tabCumul)
        .MajorUnit = 1
        .TickLabels.Font.Size = 8
        .CrossesAt = Application.min(tabCumul)
        .MajorGridlines.Delete
    End With
End With
End Sub

A+
kjin

 

[knaekes]

Re : Graphique nuage de points - VBA

@ Dranreb: cela fonctionne, mais il faudra que je résolve d'autres problèmes propres au fichier d'origine

@ Kjin: Le rendu est très bon, c'est ce à quoi je souhaite parvenir.
- Toutefois dans mon cas réel il faut considérer que les colonnes A, B et C ne sont pas accollées et que celles-ci peuvent êtres filtrées. Lorsque l'on filtre les colonnes seul les données affichées doivent êtres prises en compte par la macro.
- D'autres part les chiffres en ordonnées (les courbes) ne correspondent pas tout à fait aux données du tableau.
ex: le cumul fini à -1 (au lieu de 0)
ex: le max de suppression finit à 20 (au lieu de 22)
ex: le max d'ajout finit à 19 (au lieu de 22)
- Les dates inconnues sont à considérer équivalentes à la date la plus ancienne.

est-il possible d'adapter le fichier?

 

[kjin]

Re : Graphique nuage de points - VBA

ex: le max de suppression finit à 20 (au lieu de 22)
ex: le max d'ajout finit à 19 (au lieu de 22)

Faut-il comprendre que "inconnue" est une date ?! Et dans ce cas quoi fait-on ?

ex: le cumul fini à -1 (au lieu de 0)

Oui parce que chez moi (19 -20) = -1

Je crois qu'une explication claire s'impose
A+
kjin

 

[knaekes]

Re : Graphique nuage de points - VBA

- oui en effet lorsque la date est marquée inconnue, il faudrait réussir à la comptabiliser comme étant équivalente à la date la plus ancienne de la série (sans modifier son affichage dans la feuille excel).

Si mon explication n'est pas assez clair, n'hésite pas à m'en refaire part. merci

 

[knaekes]

Re : Graphique nuage de points - VBA

Concernant les données filtrées j'ai essayé avec

Set rng = Range("B5:C26").SpecialCells(xlCellTypeVisible)

mais les résultat n'est que partiel. En effet la zone de données prise en compte s'arrête dès la première ligne filttrée.

Comment faire ?

 

[knaekes]

Re : Graphique nuage de points - VBA

Bonjour,

Concernant les dates marquées"inconnues" je vais m'en passer, cela n'a pas vraiment de sens dans la construction de mon graphique.

En revanche concernant les lignes filtrées, donc non visibles et que je ne souhaite pas prendre en compte, je n'ai toujours pas trouvé de solution.

Auriez vous une proposition ? merci

 

[Dranreb]

Re : Graphique nuage de points - VBA

Bonjour.
Juste une piste:
ActiveSheet.Autofilter.Range.SpecialCells(xlCellTypeVisible)
renvoit un objet Range multi-zones dans le cas général.
Une double boucle: For Each Zone In PlgFiltrée.Areas
puis For Each PlgLgn In Zone.Rows
devrait permettre d'explorer toutes les lignes apparaissant dans la liste filtrée.
Toutes les variables sont à déclarer As Range.
À +

 

[knaekes]

Re : Graphique nuage de points - VBA

Salut

Merci pour l'intérêt que tu portes à mon sujet. J'ai compris ce que tu as écris mais je ne suis pas parvenu à en tirer partie.

Ci-joint tu trouveras le fichier (celui proposé par kjin). Si tu penses pouvoir y apporter ta contribution je t'enremercie par avance.

Merci

 

[knaekes]

Re : Graphique nuage de points - VBA

Bonjour

A l'aide d'un code que m'a fourni pierre jean (https://www.excel-downloads.com/threads/tableau-de-variables-et-filtres.172812/), je parviens à construire un tableau de variables. Mon but est d'utiliser ce tableau pour construire le graphique (proposé par kjin).

Ci-joint le fichier Excel. Le tableau de variables est en commentaire dans le fichier.

Merci d'avance pour votre aide

 

[Dranreb]

Re : Graphique nuage de points - VBA

Bonjour.
Je déteste les noms de variables commençant par une minuscule. Comme il n'y a plas de correction de casse je crois toujours qu'elles ne sont pas déclarées.
À par ça, réécrit comme ça, ça passe :

''''''''' avec tableau de variable
Dim T() As Variant, Ls As Long, Z As Range, Cel As Range
ReDim T(1 To 3, 1 To 5000) As Variant
Ls = 0
For Each Z In Range("A5:A" & Range("A5").End(xlDown).Row).SpecialCells(xlCellTypeVisible).Areas
   For Each Cel In Z
      Ls = Ls + 1
      T(1, Ls) = Cel.Value
      T(2, Ls) = Cel.Offset(0, 1).Value
      T(3, Ls) = Cel.Offset(0, 2).Value
      Next Cel
   Next Z
ReDim Preserve T(1 To 3, 1 To Ls) As Variant
Range("A30").Resize(UBound(T, 2), UBound(T, 1)) = Application.Transpose(T)

Mais si vous tenez vraiment à ne pas faire un graphique classique basé sur des plages, la dernière instruction est juste pour vérification.
Cordialement.