Macro: chart XY Scatter avec longueur de séries dynamique

[JuniorExcel]

Bonjour,
Comme je ne pas l accès ou je suis pour vous envoyer un exemple j essaie d' être le plus clair dans ma question.

J ai par ex des données de ce types:

A 1 1
A 2 2
A 3 3
B 1 4
B 2 6
C 1 5

J aimerai savoir si vous sauriez comment faire une macro qui me ferait un chart XY scatter qui aurait 3 séries: "A","B","C". La série "A" a 3 points (1,1),(2,2),(3,3), la série "B" a deux points (1,4),(2,6) ...
La difficulté c est que la longueur des séries pourraien changer ("A" pourrait avoir 5 points la prochaine fois) ainsi il faudrait qu il y ait une condition ...

Je n ai rien trouver sur internet... J espère que qqun sera en mesure de m aider... Merci beaucoup!

 

[mromain]

Re : Macro: chart XY Scatter avec longueur de séries dynamique

Bonsoir JuniorExcel, bonsoir le forum,


Tu trouveras un exemple en formule dans le classeur ci-joint.
Le graphique évolue au fur et à mesure que tu rajoutes des données.

Et si tu préfères, la macro suivante qui fonctionne sur ce même classeur, et qui crée un nouveau graphique avec les trois séries et leurs données (présentes au lancement de la macro).

Sub Test()
Dim graphXY As Chart, nouvSerie As Series, aX() As Double, aY() As Double, bX() As Double, bY() As Double, cX() As Double, cY() As Double, cptA As Long, cptB As Long, cptC As Long, i As Long, feuilSource As Worksheet, zoneGraphique As Range
    
    'initialiser les variables
    Set feuilSource = ThisWorkbook.Sheets("Data")
    Set zoneGraphique = feuilSource.Range("F20:M35")
    
    'récupérer dans des tableaux les valeurs X et Y pour les séries A, B et C
    ReDim aX(1 To 1): ReDim aY(1 To 1): ReDim bX(1 To 1): ReDim bY(1 To 1): ReDim cX(1 To 1): ReDim cY(1 To 1)
    For i = 2 To feuilSource.Cells(feuilSource.Rows.Count, 1).End(xlUp).Row
        Select Case feuilSource.Cells(i, 1).Text
            Case "A"
                cptA = cptA + 1
                ReDim Preserve aX(1 To cptA): aX(cptA) = feuilSource.Cells(i, 2).Value
                ReDim Preserve aY(1 To cptA): aY(cptA) = feuilSource.Cells(i, 3).Value
            Case "B"
                cptB = cptB + 1
                ReDim Preserve bX(1 To cptB): bX(cptB) = feuilSource.Cells(i, 2).Value
                ReDim Preserve bY(1 To cptB): bY(cptB) = feuilSource.Cells(i, 3).Value
            Case "C"
                cptC = cptC + 1
                ReDim Preserve cX(1 To cptC): cX(cptC) = feuilSource.Cells(i, 2).Value
                ReDim Preserve cY(1 To cptC): cY(cptC) = feuilSource.Cells(i, 3).Value
        End Select
    Next i
    
    'créer un nouveau graphique (de type XY Scatter)
    With zoneGraphique
        Set graphXY = .Parent.ChartObjects.Add(.Left, .Top, .Width, .Height).Chart
    End With
    graphXY.ChartType = xlXYScatter
    
    'ajouter la série A
    Set nouvSerie = graphXY.SeriesCollection.NewSeries
    nouvSerie.XValues = aX
    nouvSerie.Values = aY
    nouvSerie.Name = "=""Série A"""
    nouvSerie.Name = "Série A"
    
    'ajouter la série C
    Set nouvSerie = graphXY.SeriesCollection.NewSeries
    nouvSerie.XValues = bX
    nouvSerie.Values = bY
    nouvSerie.Name = "Série B"
    
    'ajouter la série C
    Set nouvSerie = graphXY.SeriesCollection.NewSeries
    nouvSerie.XValues = cX
    nouvSerie.Values = cY
    nouvSerie.Name = "Série C"
    
End Sub

A+

 

[JuniorExcel]

Re : Macro: chart XY Scatter avec longueur de séries dynamique

Merci infiniment mromain !
Bonne journée a toi et au forum

 

[JuniorExcel]

Re : Macro: chart XY Scatter avec longueur de séries dynamique

Puis-je vous demander comment adapter le code VBA si le nombre de séries n est pas défini? Il pourrait y avoir une série D et meme une série E ? Je n y arrive pas...

Merci beaucoup pour votre aide...

 

[mromain]

Re : Macro: chart XY Scatter avec longueur de séries dynamique

Bonjour JuniorExcel, le forum,

Voici un essai :

Sub Test()
Dim graphXY As Chart, nouvSerie As Series, i As Long, cpt As Long, feuilSource As Worksheet, zoneGraphique As Range
Dim tabSeries() As Variant, dicoSeries As Object, nbSeries As Long, nbPts As Long, tabValX() As Double, tabValY() As Double, derLig As Long, zoneSeries As Range, cellR As Range, memAdr As String

    'initialiser les variables
    Set feuilSource = ThisWorkbook.Sheets("Data")
    Set zoneGraphique = feuilSource.Range("F20:M35")
       
    'récupérer la liste des séries (colonne A)
    derLig = feuilSource.Cells(feuilSource.Rows.Count, 1).End(xlUp).Row
    Set dicoSeries = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    For i = 2 To derLig
        dicoSeries.Add feuilSource.Cells(i, 1).Text, feuilSource.Cells(i, 1).Text
    Next i
    On Error GoTo 0
    tabSeries = dicoSeries.Items
   
    'créer un nouveau graphique (de type XY Scatter)
    With zoneGraphique
        Set graphXY = .Parent.ChartObjects.Add(.Left, .Top, .Width, .Height).Chart
    End With
    graphXY.ChartType = xlXYScatter
    
    Set zoneSeries = feuilSource.Range(feuilSource.Cells(2, 1), feuilSource.Cells(derLig, 1))
    'boucler sur chaque série
    For i = LBound(tabSeries) To UBound(tabSeries)
    
        'récupérer les points de la série
        nbPts = WorksheetFunction.CountIf(zoneSeries, tabSeries(i))
        ReDim tabValX(1 To nbPts)
        ReDim tabValY(1 To nbPts)
        cpt = 0
        Set cellR = zoneSeries.Find(tabSeries(i), , xlValues, xlWhole)
        If Not cellR Is Nothing Then
            memAdr = cellR.Address
            Do
                cpt = cpt + 1
                tabValX(cpt) = cellR.Offset(0, 1).Value
                tabValY(cpt) = cellR.Offset(0, 2).Value
                Set cellR = zoneSeries.FindNext(cellR)
            Loop Until cellR.Address = memAdr
        End If
        
        'ajouter la série au graphique
        Set nouvSerie = graphXY.SeriesCollection.NewSeries
        nouvSerie.Name = tabSeries(i)
        nouvSerie.XValues = tabValX
        nouvSerie.Values = tabValY
    Next i
       
End Sub

A+

 

[JuniorExcel]

Re : Macro: chart XY Scatter avec longueur de séries dynamique

Juste génial ... Vraiment merci mille....
Si seulement je savais coder comme ça

Excellent ce forum!

Je te souhaite une très bonne journée !