XL 2013 new collection par rapport à des graphiques

[babalouche]

Bonjour le forum,
J'ai une question qui serait si avec une new collection il serait possible ( avec une formule que je n'ai pas trouvé ou autre ) de prendre toutes les valeurs pour les utiliser en abscisses sur un graphique et les clés en ordonnées par exemple ? En ne connaissant pas le nombre de clés et valeurs.

Merci de votre réponse.

 

[job75]

Bonjour babalouche, le forum,

Oui c'est possible avec une collection ou comme ici avec un Dictionary :

Sub MAJ_Graph()
Dim t, d As Object, i&
t = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
    d(t(i, 1)) = t(i, 2)
Next
ThisWorkbook.Names.Add "X", d.keys 'nom défini
ThisWorkbook.Names.Add "Y", d.items 'nom défini
With ChartObjects(1).Chart.SeriesCollection(1)
    .XValues = "='" & ThisWorkbook.Name & "'!X" 'MAJ abscisses
    .Values = "='" & ThisWorkbook.Name & "'!Y" 'MAJ ordonnées
End With
End Sub

Il faut créer 2 noms définis X et Y qui sont des tableaux.

Comme toutes les formules leurs formules sont limitées à 8192 caractères.

Fichier joint.

A+

 

[babalouche]

D'accord merci bien je vais prendre ca

 

[babalouche]

Connaissez vous une formule ou des lignes de code pour supprimer le contenu du dico mais le garder quand même.

 

[babalouche]

Bonjour en appliquant votre code j'obtiens une erreur 1004 à la ligne

ThisWorkbook.Names.Add "X", d.keys

 

[job75]

Bonjour babalouche,

Si le tableau peut n'avoir qu'une seule ligne compléter :

t = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide
If UBound(t) = 1 Then Exit Sub

Et si la formule a plus de 8192 caractères on n'y peut rien !

A+

 

[babalouche]

Voici une partie de mon code pour que vous comprenez mieux. C'est une macro qui sur un autre fichier ouvert contient un tableau et fait des graphiques du tableau pour l'instant ça marchait pour les nombres mais là avec le dictionnaire c'est dans le cas où la colonne est composée de texte que je cherche à compter le nombre d'apparitions de chaque valeur et d'en faire un camembert ensuite.

Sub Workbook_Open()
    Dim Wbk As Workbook, Cht As Chart, RngTit As Range, RngDon As Range, _
    ColDate As Long, Col As Long, Sér As Series, Titre As String, ligne As Long, dat As Date, lig As Long
    Dim mot As String, lign As Long, t, d As Object, i&
    For Each Wbk In Application.Workbooks
        If Wbk.Name <> ThisWorkbook.Name Then Exit For
    Next Wbk
    Set RngDon = Wbk.Worksheets(1).UsedRange
    For ColDate = 1 To RngDon.Columns.Count + 2
        If IsDate(RngDon(2, ColDate).Value) Then Exit For
    Next ColDate
    If ColDate > RngDon.Columns.Count Then
        ColDate = 1
    End If
    Set RngTit = RngDon.Rows(1)
    Set RngDon = RngDon.Rows(2).Resize(RngDon.Rows.Count - 1)

    For Col = 1 To RngTit.Columns.Count
        If Col <> ColDate Then
            If VarType(RngDon.Cells(1, Col).Value) = 8 Then
                Set d = CreateObject("Scripting.Dictionary")
                For lign = 1 To RngDon.Rows.Count
                    mot = RngDon.Cells(lign, Col)
                    If Not d.exists(mot) Then
                        d.Add mot, 1
                    Else
                        d(mot) = d(mot) + 1
                    End If
                Next lign
                ThisWorkbook.Names.Add "X", d.keys
                ThisWorkbook.Names.Add "Y", d.items
                Titre = RngTit.Columns(Col)
                On Error Resume Next
                Set Cht = Wbk.Charts(Titre)
                If Err Then Set Cht = Wbk.Charts.Add: Cht.Name = Titre
                With Cht.SeriesCollection
                    Do While .Count > 1: .Item(1).Delete: Loop
                    Err.Clear: Set Sér = .Item(1): If Err Then Set Sér = .NewSeries
                    End With
                On Error GoTo 0
                t = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide
                If UBound(t) = 1 Then Exit For
                For i = 2 To UBound(t)
                    d(t(i, 1)) = t(i, 2)
                Next
                Sér.XValues = "='" & ThisWorkbook.Name & "'!Y"
                Sér.Values = "='" & ThisWorkbook.Name & "'!X"
                Sér.Name = RngTit.Columns(Col)
                Cht.ChartType = xlPie
                Cht.ChartStyle = 259