XL 2016 Vba plage variable sous conditions pour tracer des graphiques

[remex32]

Bonjour,
Je souhaiterais trouver une fonction qui sur le graphique actif change la plage en fonction d'une condition qui est en gros : "à chaque fois que le caractère "ù" est selectionné, prendre la plage si dessous pour le graphique jusqu'à une case vide et ainsi de suite. Je vous met en PJ mon fichier est mon code pour que vous compreniez mieux, merci d'avance.

Sub Macro1()
Dim x As Integer
Dim nbcourbe As Integer
Dim ù As String
nbcourbe = 0
x = 1
ù = "ù"
Sheets("Feuil1").Select
Range("A1").Select
Do While nbcourbe < 124
Do While Not ActiveCell.Value = ù
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(1, 1).Select
Do While Not IsEmpty(ActiveCell)
Sheets("Graphique1").Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(x).XValues = "=Feuil1!$B5:$B9"
ActiveChart.FullSeriesCollection(x).Values = "=Feuil1!$C5:$C9"
x = x + 1
Sheets("Feuil1").Select
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(1, -1).Select
nbcourbe = nbcourbe + 1
Loop
End Sub

 

[remex32]

Pour être un peu plus clair, je souhaite modifier mon :
ActiveChart.FullSeriesCollection(x).XValues = "=Feuil1!$B5:$B9"
ActiveChart.FullSeriesCollection(x).Values = "=Feuil1!$C5:$C9"
en plage variable sous condition "si ù est en haut de la série" pour ainsi faire une boucle et que ça ajoute des courbe avec les différente donnée sous les"ù". Merci

 

[Dranreb]

Bonjour
Comme ça :

Sub Macro2()
   Dim Cel As Range, RDon As Range, Ser As Series
   For Each Cel In Feuil1.Columns(1).SpecialCells(xlCellTypeConstants, 2)
      If Cel.Value = "ù" Then
         Set RDon = Cel.CurrentRegion
         Set Ser = Graphique2.SeriesCollection.NewSeries
         Ser.XValues = "=" & RDon(2, 2).Resize(RDon.Rows.Count - 1).Address(External:=True)
         Ser.Values = "=" & RDon(2, 3).Resize(RDon.Rows.Count - 1).Address(External:=True)
         End If
      Next Cel
   End Sub

 

[remex32]

Bonjour
Comme ça :

Sub Macro2()
   Dim Cel As Range, RDon As Range, Ser As Series
   For Each Cel In Feuil1.Columns(1).SpecialCells(xlCellTypeConstants, 2)
      If Cel.Value = "ù" Then
         Set RDon = Cel.CurrentRegion
         Set Ser = Graphique2.SeriesCollection.NewSeries
         Ser.XValues = "=" & RDon(2, 2).Resize(RDon.Rows.Count - 1).Address(External:=True)
         Ser.Values = "=" & RDon(2, 3).Resize(RDon.Rows.Count - 1).Address(External:=True)
         End If
      Next Cel
   End Sub

Pour commencer, un grand merci de m'être venu en aide ! Je suis peu a l'aise en programmation ... le code que vous venez de me donner je le cale où dans mon programme ? Dois-je supprimer qqc ? Encore merci ... je suis en galère ..

 

[remex32]

Bonjour
Comme ça :

Sub Macro2()
   Dim Cel As Range, RDon As Range, Ser As Series
   For Each Cel In Feuil1.Columns(1).SpecialCells(xlCellTypeConstants, 2)
      If Cel.Value = "ù" Then
         Set RDon = Cel.CurrentRegion
         Set Ser = Graphique2.SeriesCollection.NewSeries
         Ser.XValues = "=" & RDon(2, 2).Resize(RDon.Rows.Count - 1).Address(External:=True)
         Ser.Values = "=" & RDon(2, 3).Resize(RDon.Rows.Count - 1).Address(External:=True)
         End If
      Next Cel
   End Sub

Erreur '424' : objet requis
Je ne comprend pas

 

[Dranreb]

Sur quelle instruction avez vous "Objet requis" ?
Probablement sur une de vos instructions que je n'avais pas dit de mettre.
Je me suis basé sur ce qu'il y avait dans le classeur que vous aviez joint, soit :
Une feuille graphique "Graphique1" représentée par un objet VBA de type Chart qui s'appelle Graphique2,
et une feuille de calcul "Feuil1" représentée par un objet VBA de type Worksheet qui s'appelle Feuil1.

 

[remex32]

Pouvez-vous alors expliquer les fonctions du prgm que vous m'avez donné ? Effectivement j'essai d'adapter ce prgm à un fichier confidentiel néanmoins la petite base de données que vous ai fourni est dans la même idée. Je m'explique : en colonne A lorsque l'on tombe sur un "ù" ajouter une courbe C=f(B) au "Graphique1" jusqu'à ce que l'on tombe sur une ligne vide et ensuite recommencer et ainsi de suite. A la fin du compte j'aimerais avoir un graphique avec 125 courbes C=f(B) sur le graphique.

 

[remex32]

Aussi un autre point, j'aimerai creer le graphe vierge avant d'y insérer les courbes. Lorsque je met ces lignes de code avant le prgm, plus rien de fonctionne. Un avis ? Merci d'avance ...

ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select
ActiveChart.Location Where:=xlLocationAsNewSheet
ActiveChart.FullSeriesCollection(1).Name = "=""kN=f(mm)"""

 

[Dranreb]

Ne serait-il pas plus simple d'avoir toujours la même feuille graphique mais d'y supprimer préalablement les anciennes séries ?

Sub Macro2()
   Dim Cel As Range, RDon As Range, Ser As Series
   While Graphique2.SeriesCollection.Count > 0
      Graphique2.SeriesCollection(1).Delete: Wend
   For Each Cel In Feuil1.Columns(1).SpecialCells(xlCellTypeConstants, 2)
      If Cel.Value = "ù" Then
         Set RDon = Cel.CurrentRegion
         Set Ser = Graphique2.SeriesCollection.NewSeries
         Ser.Name = Cel(1, 3).Value & "=f(" & Cel(1, 2).Value & ")"
         Ser.XValues = "=" & RDon(2, 2).Resize(RDon.Rows.Count - 1).Address(External:=True)
         Ser.Values = "=" & RDon(2, 3).Resize(RDon.Rows.Count - 1).Address(External:=True)
         End If
      Next Cel
   End Sub

Remplacez Feuil1 et Graphique2 par les noms des objets Workseet et Chart qui représentent la feuille de calcul et la feuille graphique dans votre autre classeur. Vous les trouverez dans la rubrique Microsoft Excel Objets du projet VBA, dans l'explorateur de projets. Le nom des entités Excel qu'ils représentent sont rappelés à leur droite entre parenthèses.

 

[Dranreb]

Remarque: Feuil1.Columns(1).SpecialCells(xlCellTypeConstants, 2) représente toutes les cellules de la colonne A qui contiennent un texte. C'est ce qui est sélectionné quand on sélectionne la colonne A, puis menu Accueil, groupe Edition, commande Rechercher et sélectionner, sous commande Atteindre…, Cellules…, Constantes et Texte.
Pour CurrentRegion c'est à peu près les mêmes manœuvres sauf qu'on atteint la Zone en cours (à partir de la cellule sélectionnée, non comme ici à partir de chaque cellule contenant un "ù")

 

[remex32]

Ne serait-il pas plus simple d'avoir toujours la même feuille graphique mais d'y supprimer préalablement les anciennes séries ?

Sub Macro2()
   Dim Cel As Range, RDon As Range, Ser As Series
   While Graphique2.SeriesCollection.Count > 0
      Graphique2.SeriesCollection(1).Delete: Wend
   For Each Cel In Feuil1.Columns(1).SpecialCells(xlCellTypeConstants, 2)
      If Cel.Value = "ù" Then
         Set RDon = Cel.CurrentRegion
         Set Ser = Graphique2.SeriesCollection.NewSeries
         Ser.Name = Cel(1, 3).Value & "=f(" & Cel(1, 2).Value & ")"
         Ser.XValues = "=" & RDon(2, 2).Resize(RDon.Rows.Count - 1).Address(External:=True)
         Ser.Values = "=" & RDon(2, 3).Resize(RDon.Rows.Count - 1).Address(External:=True)
         End If
      Next Cel
   End Sub

Remplacez Feuil1 et Graphique2 par les noms des objets Workseet et Chart qui représentent la feuille de calcul et la feuille graphique dans votre autre classeur. Vous les trouverez dans la rubrique Microsoft Excel Objets du projet VBA, dans l'explorateur de projets. Le nom des entités Excel qu'ils représentent sont rappelés à leur droite entre parenthèses.

Pas vraiment, je souhaite avoir sur le même graph les 125 series donc les conserver et non les supprimer.
J'ai tjr le même soucis (erreur 424 objet requis) avec ces lignes :

Graphique2.SeriesCollection(1).Delete: Wend

Set Ser = Graphique2.SeriesCollection.NewSeries

Pour le moment j'essai de comprendre sur le fichier basique que je vous ai mis en lien plus haut, donc j'ouvre un graphique sur une autre feuille que j'appel Graphique2 (vu que dans le prgm c'est noté "Graphique.2") et je lance votre prgm et là malheureusement cette même erreur 424 apparait lors de l'exécution pour les deux lignes mentionnés juste au dessus. une idée ? Ou peut être que je n'ai pas compris l'idée de "Graphique2.SeriesCollection" ...

 

[Dranreb]

Il ne s'agit pas du nom de la feuille graphique. On s'en fout de celui là vous pouvez y mettre n'importe quoi et le changer par la suite. Il s'agit du nom de l'objet Chart, lequel n'est pas cette entité Excel mais un objet VBA qui permet de la manipuler. C'est dans la fenêtre de propriétés de VBE qu'il faut changer son nom. Comme pour la plupart des objets VBA c'est la 1ère ligne qu'il faut changer. Il y a (Name) devant, comme ça, avec des parenthèses parce que ce n'est pas une propriété, en fait, mais son nom.

Autre point: Si vous voulez pouvoir conserver les anciennes séries de façon à pouvoir en ajouter d'autres, il ne faut certes pas supprimer préalablement les anciennes, mais alors il ne faut pas non plus, dans la macro "creer le graphe vierge avant d'y insérer les courbes", comme vous dites.
Mais on pourrait mettre dans une macro à part le code qui supprime toutes les séries, au besoin.

 

[remex32]

Ah d'accord, je ne connaissais même pas l'existence de cette onglet, merci beaucoup !

 

[remex32]

Pas vraiment, je souhaite avoir sur le même graph les 125 series donc les conserver et non les supprimer.
J'ai tjr le même soucis (erreur 424 objet requis) avec ces lignes :

Graphique2.SeriesCollection(1).Delete: Wend

Set Ser = Graphique2.SeriesCollection.NewSeries

Pour le moment j'essai de comprendre sur le fichier basique que je vous ai mis en lien plus haut, donc j'ouvre un graphique sur une autre feuille que j'appel Graphique2 (vu que dans le prgm c'est noté "Graphique.2") et je lance votre prgm et là malheureusement cette même erreur 424 apparait lors de l'exécution pour les deux lignes mentionnés juste au dessus. une idée ? Ou peut être que je n'ai pas compris l'idée de "Graphique2.SeriesCollection" ...

Une dernière petite chose ... mon fichier est blindé de donnée (+1.000.000 lignes) possible de mettre en place un boucle pour faire un graphique de 125 courbes ? Au delà de 256 j'obtiens une erreur comme quoi il est impossible d'avoir + de 256 séries. Merci

 

[Dranreb]

125 c'est inférieur à 256 !