Bonjour,
Je travaille au corps la macro de T. Ogilvy car les coefficients
négatifs n'étaient pas traités dans la version originale.
La conversion des virgules en points posent un problème si on garde le
caractère x, alors autant l'enlever.
Ma première version était correcte pour des équations du premier deg ré
mais pour des degré supérieurs, elle ne fonctionnait pas.
La première partie de semble bien remplir le tableau (10x2) pour un degr é 4.
Mais je bloque sur le Redim Preserve : Indice en dehors de la plage
(erreur 9)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Une aide serait fortement appréciée pour passer ce point, ce qui me
permettait de mettre au point le vidage du tableau vers les cellules.
Naturellement je vais mettre cette version (au point) dans l'autre fil).
Merci d'avance
fetnat
Sub GetFormula()
'"Tom Ogilvy" : extrait les coef d'une équation (à partir du label du
graphique)
' coeficient supérieur en N6 (et en dessous) et degré en O6
Dim sStr As String, sStr1 As String, sStr2 As String
Dim sFormula As String, j As Long, k As Long
Dim i As Long
Dim ser As Series, sChar As String
Dim tline As Trendline
Dim cht As Chart
Dim rng As Range
Dim varr()
ReDim varr(1 To 10, 1 To 2)
Set cht = ActiveSheet.ChartObjects(1).Chart
For Each ser In cht.SeriesCollection
If ser.Trendlines.Count = 1 Then
Set tline = ser.Trendlines(1)
If tline.DisplayEquation Then
sFormula = tline.DataLabel.Text '<== this gets the
formula
sFormula = Application.Substitute(sFo rmula, "y = ", "")
sFormula = Application.Substitute(sFo rmula, ",", ".")
sFormula = Application.Substitute(sFo rmula, " + ", ",")
sFormula = Application.Substitute(sFo rmula, " - ", ",-")
Debug.Print sFormula
j = 1
For i = 1 To Len(sFormula) + 1
sChar = Mid(sFormula, i, 1)
If sChar = "," Or i = Len(s Formula) + 1 Then
If i = Len(sFormula) + 1 Then
sStr1 = sStr1 & sChar
End If
varr(j, 1) = sStr1
varr(j, 2) = sStr2
Debug.Print j; varr(j, 1); varr(j, 2)
sStr1 = ""
sStr2 = ""
j = j + 1
Else
If sChar <> "x" Then
sStr1 = sStr1 & sChar
Else
If Mid(sFormula , i + 1, 1) <> "," Then
sStr2 = sStr2 & sChar & Mid(sFormula, i
+ 1, 1)
i = i + 1
Else
sStr2 = sStr2 & sChar
End If
End If
End If
Next
Debug.Print j; varr(j - 1, 1); varr(j - 1, 2)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Set rng = Range("N6")
j = 1
For i = LBound(varr) To UBound(varr)
Debug.Print i; varr(i)
rng(j, 1) = CVar(varr(i, 1))
rng(j, 2) = CVar(varr(i, 2))
Debug.Print j; rng(j)
j = j + 1
Next i
Exit Sub
End If
End If
Next
End Sub
Bonjour,
Je travaille au corps la macro de T. Ogilvy car les coefficients
négatifs n'étaient pas traités dans la version originale.
La conversion des virgules en points posent un problème si on garde le
caractère x, alors autant l'enlever.
Ma première version était correcte pour des équations du premier deg ré
mais pour des degré supérieurs, elle ne fonctionnait pas.
La première partie de semble bien remplir le tableau (10x2) pour un degr é 4.
Mais je bloque sur le Redim Preserve : Indice en dehors de la plage
(erreur 9)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Une aide serait fortement appréciée pour passer ce point, ce qui me
permettait de mettre au point le vidage du tableau vers les cellules.
Naturellement je vais mettre cette version (au point) dans l'autre fil).
Merci d'avance
fetnat
Sub GetFormula()
'"Tom Ogilvy" : extrait les coef d'une équation (à partir du label du
graphique)
' coeficient supérieur en N6 (et en dessous) et degré en O6
Dim sStr As String, sStr1 As String, sStr2 As String
Dim sFormula As String, j As Long, k As Long
Dim i As Long
Dim ser As Series, sChar As String
Dim tline As Trendline
Dim cht As Chart
Dim rng As Range
Dim varr()
ReDim varr(1 To 10, 1 To 2)
Set cht = ActiveSheet.ChartObjects(1).Chart
For Each ser In cht.SeriesCollection
If ser.Trendlines.Count = 1 Then
Set tline = ser.Trendlines(1)
If tline.DisplayEquation Then
sFormula = tline.DataLabel.Text '<== this gets the
formula
sFormula = Application.Substitute(sFo rmula, "y = ", "")
sFormula = Application.Substitute(sFo rmula, ",", ".")
sFormula = Application.Substitute(sFo rmula, " + ", ",")
sFormula = Application.Substitute(sFo rmula, " - ", ",-")
Debug.Print sFormula
j = 1
For i = 1 To Len(sFormula) + 1
sChar = Mid(sFormula, i, 1)
If sChar = "," Or i = Len(s Formula) + 1 Then
If i = Len(sFormula) + 1 Then
sStr1 = sStr1 & sChar
End If
varr(j, 1) = sStr1
varr(j, 2) = sStr2
Debug.Print j; varr(j, 1); varr(j, 2)
sStr1 = ""
sStr2 = ""
j = j + 1
Else
If sChar <> "x" Then
sStr1 = sStr1 & sChar
Else
If Mid(sFormula , i + 1, 1) <> "," Then
sStr2 = sStr2 & sChar & Mid(sFormula, i
+ 1, 1)
i = i + 1
Else
sStr2 = sStr2 & sChar
End If
End If
End If
Next
Debug.Print j; varr(j - 1, 1); varr(j - 1, 2)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Set rng = Range("N6")
j = 1
For i = LBound(varr) To UBound(varr)
Debug.Print i; varr(i)
rng(j, 1) = CVar(varr(i, 1))
rng(j, 2) = CVar(varr(i, 2))
Debug.Print j; rng(j)
j = j + 1
Next i
Exit Sub
End If
End If
Next
End Sub
Bonjour,
Je travaille au corps la macro de T. Ogilvy car les coefficients
négatifs n'étaient pas traités dans la version originale.
La conversion des virgules en points posent un problème si on garde le
caractère x, alors autant l'enlever.
Ma première version était correcte pour des équations du premier deg ré
mais pour des degré supérieurs, elle ne fonctionnait pas.
La première partie de semble bien remplir le tableau (10x2) pour un degr é 4.
Mais je bloque sur le Redim Preserve : Indice en dehors de la plage
(erreur 9)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Une aide serait fortement appréciée pour passer ce point, ce qui me
permettait de mettre au point le vidage du tableau vers les cellules.
Naturellement je vais mettre cette version (au point) dans l'autre fil).
Merci d'avance
fetnat
Sub GetFormula()
'"Tom Ogilvy" : extrait les coef d'une équation (à partir du label du
graphique)
' coeficient supérieur en N6 (et en dessous) et degré en O6
Dim sStr As String, sStr1 As String, sStr2 As String
Dim sFormula As String, j As Long, k As Long
Dim i As Long
Dim ser As Series, sChar As String
Dim tline As Trendline
Dim cht As Chart
Dim rng As Range
Dim varr()
ReDim varr(1 To 10, 1 To 2)
Set cht = ActiveSheet.ChartObjects(1).Chart
For Each ser In cht.SeriesCollection
If ser.Trendlines.Count = 1 Then
Set tline = ser.Trendlines(1)
If tline.DisplayEquation Then
sFormula = tline.DataLabel.Text '<== this gets the
formula
sFormula = Application.Substitute(sFo rmula, "y = ", "")
sFormula = Application.Substitute(sFo rmula, ",", ".")
sFormula = Application.Substitute(sFo rmula, " + ", ",")
sFormula = Application.Substitute(sFo rmula, " - ", ",-")
Debug.Print sFormula
j = 1
For i = 1 To Len(sFormula) + 1
sChar = Mid(sFormula, i, 1)
If sChar = "," Or i = Len(s Formula) + 1 Then
If i = Len(sFormula) + 1 Then
sStr1 = sStr1 & sChar
End If
varr(j, 1) = sStr1
varr(j, 2) = sStr2
Debug.Print j; varr(j, 1); varr(j, 2)
sStr1 = ""
sStr2 = ""
j = j + 1
Else
If sChar <> "x" Then
sStr1 = sStr1 & sChar
Else
If Mid(sFormula , i + 1, 1) <> "," Then
sStr2 = sStr2 & sChar & Mid(sFormula, i
+ 1, 1)
i = i + 1
Else
sStr2 = sStr2 & sChar
End If
End If
End If
Next
Debug.Print j; varr(j - 1, 1); varr(j - 1, 2)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Set rng = Range("N6")
j = 1
For i = LBound(varr) To UBound(varr)
Debug.Print i; varr(i)
rng(j, 1) = CVar(varr(i, 1))
rng(j, 2) = CVar(varr(i, 2))
Debug.Print j; rng(j)
j = j + 1
Next i
Exit Sub
End If
End If
Next
End Sub
Bonjour,
Avec l'option Preserve , seule la dernière dimension peut être
modifiée
Dim b()
ReDim Preserve b(1 To 5, 1 To 2)
ReDim Preserve b(1 To 5, 1 To 3)
JB
On 4 mar, 13:38, fetnat wrote:Bonjour,
Je travaille au corps la macro de T. Ogilvy car les coefficients
négatifs n'étaient pas traités dans la version originale.
La conversion des virgules en points posent un problème si on garde le
caractère x, alors autant l'enlever.
Ma première version était correcte pour des équations du premier degré
mais pour des degré supérieurs, elle ne fonctionnait pas.
La première partie de semble bien remplir le tableau (10x2) pour un degré 4.
Mais je bloque sur le Redim Preserve : Indice en dehors de la plage
(erreur 9)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Une aide serait fortement appréciée pour passer ce point, ce qui me
permettait de mettre au point le vidage du tableau vers les cellules.
Naturellement je vais mettre cette version (au point) dans l'autre fil).
Merci d'avance
fetnat
Sub GetFormula()
'"Tom Ogilvy" : extrait les coef d'une équation (à partir du label du
graphique)
' coeficient supérieur en N6 (et en dessous) et degré en O6
Dim sStr As String, sStr1 As String, sStr2 As String
Dim sFormula As String, j As Long, k As Long
Dim i As Long
Dim ser As Series, sChar As String
Dim tline As Trendline
Dim cht As Chart
Dim rng As Range
Dim varr()
ReDim varr(1 To 10, 1 To 2)
Set cht = ActiveSheet.ChartObjects(1).Chart
For Each ser In cht.SeriesCollection
If ser.Trendlines.Count = 1 Then
Set tline = ser.Trendlines(1)
If tline.DisplayEquation Then
sFormula = tline.DataLabel.Text '<== this gets the
formula
sFormula = Application.Substitute(sFormula, "y = ", "")
sFormula = Application.Substitute(sFormula, ",", ".")
sFormula = Application.Substitute(sFormula, " + ", ",")
sFormula = Application.Substitute(sFormula, " - ", ",-")
Debug.Print sFormula
j = 1
For i = 1 To Len(sFormula) + 1
sChar = Mid(sFormula, i, 1)
If sChar = "," Or i = Len(sFormula) + 1 Then
If i = Len(sFormula) + 1 Then
sStr1 = sStr1 & sChar
End If
varr(j, 1) = sStr1
varr(j, 2) = sStr2
Debug.Print j; varr(j, 1); varr(j, 2)
sStr1 = ""
sStr2 = ""
j = j + 1
Else
If sChar <> "x" Then
sStr1 = sStr1 & sChar
Else
If Mid(sFormula, i + 1, 1) <> "," Then
sStr2 = sStr2 & sChar & Mid(sFormula, i
+ 1, 1)
i = i + 1
Else
sStr2 = sStr2 & sChar
End If
End If
End If
Next
Debug.Print j; varr(j - 1, 1); varr(j - 1, 2)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Set rng = Range("N6")
j = 1
For i = LBound(varr) To UBound(varr)
Debug.Print i; varr(i)
rng(j, 1) = CVar(varr(i, 1))
rng(j, 2) = CVar(varr(i, 2))
Debug.Print j; rng(j)
j = j + 1
Next i
Exit Sub
End If
End If
Next
End Sub
Bonjour,
Avec l'option Preserve , seule la dernière dimension peut être
modifiée
Dim b()
ReDim Preserve b(1 To 5, 1 To 2)
ReDim Preserve b(1 To 5, 1 To 3)
JB
On 4 mar, 13:38, fetnat <fet...@caramail.com> wrote:
Bonjour,
Je travaille au corps la macro de T. Ogilvy car les coefficients
négatifs n'étaient pas traités dans la version originale.
La conversion des virgules en points posent un problème si on garde le
caractère x, alors autant l'enlever.
Ma première version était correcte pour des équations du premier degré
mais pour des degré supérieurs, elle ne fonctionnait pas.
La première partie de semble bien remplir le tableau (10x2) pour un degré 4.
Mais je bloque sur le Redim Preserve : Indice en dehors de la plage
(erreur 9)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Une aide serait fortement appréciée pour passer ce point, ce qui me
permettait de mettre au point le vidage du tableau vers les cellules.
Naturellement je vais mettre cette version (au point) dans l'autre fil).
Merci d'avance
fetnat
Sub GetFormula()
'"Tom Ogilvy" : extrait les coef d'une équation (à partir du label du
graphique)
' coeficient supérieur en N6 (et en dessous) et degré en O6
Dim sStr As String, sStr1 As String, sStr2 As String
Dim sFormula As String, j As Long, k As Long
Dim i As Long
Dim ser As Series, sChar As String
Dim tline As Trendline
Dim cht As Chart
Dim rng As Range
Dim varr()
ReDim varr(1 To 10, 1 To 2)
Set cht = ActiveSheet.ChartObjects(1).Chart
For Each ser In cht.SeriesCollection
If ser.Trendlines.Count = 1 Then
Set tline = ser.Trendlines(1)
If tline.DisplayEquation Then
sFormula = tline.DataLabel.Text '<== this gets the
formula
sFormula = Application.Substitute(sFormula, "y = ", "")
sFormula = Application.Substitute(sFormula, ",", ".")
sFormula = Application.Substitute(sFormula, " + ", ",")
sFormula = Application.Substitute(sFormula, " - ", ",-")
Debug.Print sFormula
j = 1
For i = 1 To Len(sFormula) + 1
sChar = Mid(sFormula, i, 1)
If sChar = "," Or i = Len(sFormula) + 1 Then
If i = Len(sFormula) + 1 Then
sStr1 = sStr1 & sChar
End If
varr(j, 1) = sStr1
varr(j, 2) = sStr2
Debug.Print j; varr(j, 1); varr(j, 2)
sStr1 = ""
sStr2 = ""
j = j + 1
Else
If sChar <> "x" Then
sStr1 = sStr1 & sChar
Else
If Mid(sFormula, i + 1, 1) <> "," Then
sStr2 = sStr2 & sChar & Mid(sFormula, i
+ 1, 1)
i = i + 1
Else
sStr2 = sStr2 & sChar
End If
End If
End If
Next
Debug.Print j; varr(j - 1, 1); varr(j - 1, 2)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Set rng = Range("N6")
j = 1
For i = LBound(varr) To UBound(varr)
Debug.Print i; varr(i)
rng(j, 1) = CVar(varr(i, 1))
rng(j, 2) = CVar(varr(i, 2))
Debug.Print j; rng(j)
j = j + 1
Next i
Exit Sub
End If
End If
Next
End Sub
Bonjour,
Avec l'option Preserve , seule la dernière dimension peut être
modifiée
Dim b()
ReDim Preserve b(1 To 5, 1 To 2)
ReDim Preserve b(1 To 5, 1 To 3)
JB
On 4 mar, 13:38, fetnat wrote:Bonjour,
Je travaille au corps la macro de T. Ogilvy car les coefficients
négatifs n'étaient pas traités dans la version originale.
La conversion des virgules en points posent un problème si on garde le
caractère x, alors autant l'enlever.
Ma première version était correcte pour des équations du premier degré
mais pour des degré supérieurs, elle ne fonctionnait pas.
La première partie de semble bien remplir le tableau (10x2) pour un degré 4.
Mais je bloque sur le Redim Preserve : Indice en dehors de la plage
(erreur 9)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Une aide serait fortement appréciée pour passer ce point, ce qui me
permettait de mettre au point le vidage du tableau vers les cellules.
Naturellement je vais mettre cette version (au point) dans l'autre fil).
Merci d'avance
fetnat
Sub GetFormula()
'"Tom Ogilvy" : extrait les coef d'une équation (à partir du label du
graphique)
' coeficient supérieur en N6 (et en dessous) et degré en O6
Dim sStr As String, sStr1 As String, sStr2 As String
Dim sFormula As String, j As Long, k As Long
Dim i As Long
Dim ser As Series, sChar As String
Dim tline As Trendline
Dim cht As Chart
Dim rng As Range
Dim varr()
ReDim varr(1 To 10, 1 To 2)
Set cht = ActiveSheet.ChartObjects(1).Chart
For Each ser In cht.SeriesCollection
If ser.Trendlines.Count = 1 Then
Set tline = ser.Trendlines(1)
If tline.DisplayEquation Then
sFormula = tline.DataLabel.Text '<== this gets the
formula
sFormula = Application.Substitute(sFormula, "y = ", "")
sFormula = Application.Substitute(sFormula, ",", ".")
sFormula = Application.Substitute(sFormula, " + ", ",")
sFormula = Application.Substitute(sFormula, " - ", ",-")
Debug.Print sFormula
j = 1
For i = 1 To Len(sFormula) + 1
sChar = Mid(sFormula, i, 1)
If sChar = "," Or i = Len(sFormula) + 1 Then
If i = Len(sFormula) + 1 Then
sStr1 = sStr1 & sChar
End If
varr(j, 1) = sStr1
varr(j, 2) = sStr2
Debug.Print j; varr(j, 1); varr(j, 2)
sStr1 = ""
sStr2 = ""
j = j + 1
Else
If sChar <> "x" Then
sStr1 = sStr1 & sChar
Else
If Mid(sFormula, i + 1, 1) <> "," Then
sStr2 = sStr2 & sChar & Mid(sFormula, i
+ 1, 1)
i = i + 1
Else
sStr2 = sStr2 & sChar
End If
End If
End If
Next
Debug.Print j; varr(j - 1, 1); varr(j - 1, 2)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Set rng = Range("N6")
j = 1
For i = LBound(varr) To UBound(varr)
Debug.Print i; varr(i)
rng(j, 1) = CVar(varr(i, 1))
rng(j, 2) = CVar(varr(i, 2))
Debug.Print j; rng(j)
j = j + 1
Next i
Exit Sub
End If
End If
Next
End Sub
| ReDim Preserve varr(1 To j - 1, 1 To 2)
Si tu utilises "Preserve", seulement la dernière dimension de ton tableau est redimensionnable.
"fetnat" a écrit dans le message de news:
Bonjour,
Je travaille au corps la macro de T. Ogilvy car les coefficients
négatifs n'étaient pas traités dans la version originale.
La conversion des virgules en points posent un problème si on garde le
caractère x, alors autant l'enlever.
Ma première version était correcte pour des équations du premier degré
mais pour des degré supérieurs, elle ne fonctionnait pas.
La première partie de semble bien remplir le tableau (10x2) pour un degré 4.
Mais je bloque sur le Redim Preserve : Indice en dehors de la plage
(erreur 9)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Une aide serait fortement appréciée pour passer ce point, ce qui me
permettait de mettre au point le vidage du tableau vers les cellules.
Naturellement je vais mettre cette version (au point) dans l'autre fil).
Merci d'avance
fetnat
Sub GetFormula()
'"Tom Ogilvy" : extrait les coef d'une équation (à partir du label du
graphique)
' coeficient supérieur en N6 (et en dessous) et degré en O6
Dim sStr As String, sStr1 As String, sStr2 As String
Dim sFormula As String, j As Long, k As Long
Dim i As Long
Dim ser As Series, sChar As String
Dim tline As Trendline
Dim cht As Chart
Dim rng As Range
Dim varr()
ReDim varr(1 To 10, 1 To 2)
Set cht = ActiveSheet.ChartObjects(1).Chart
For Each ser In cht.SeriesCollection
If ser.Trendlines.Count = 1 Then
Set tline = ser.Trendlines(1)
If tline.DisplayEquation Then
sFormula = tline.DataLabel.Text '<== this gets the
formula
sFormula = Application.Substitute(sFormula, "y = ", "")
sFormula = Application.Substitute(sFormula, ",", ".")
sFormula = Application.Substitute(sFormula, " + ", ",")
sFormula = Application.Substitute(sFormula, " - ", ",-")
Debug.Print sFormula
j = 1
For i = 1 To Len(sFormula) + 1
sChar = Mid(sFormula, i, 1)
If sChar = "," Or i = Len(sFormula) + 1 Then
If i = Len(sFormula) + 1 Then
sStr1 = sStr1 & sChar
End If
varr(j, 1) = sStr1
varr(j, 2) = sStr2
Debug.Print j; varr(j, 1); varr(j, 2)
sStr1 = ""
sStr2 = ""
j = j + 1
Else
If sChar <> "x" Then
sStr1 = sStr1 & sChar
Else
If Mid(sFormula, i + 1, 1) <> "," Then
sStr2 = sStr2 & sChar & Mid(sFormula, i
+ 1, 1)
i = i + 1
Else
sStr2 = sStr2 & sChar
End If
End If
End If
Next
Debug.Print j; varr(j - 1, 1); varr(j - 1, 2)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Set rng = Range("N6")
j = 1
For i = LBound(varr) To UBound(varr)
Debug.Print i; varr(i)
rng(j, 1) = CVar(varr(i, 1))
rng(j, 2) = CVar(varr(i, 2))
Debug.Print j; rng(j)
j = j + 1
Next i
Exit Sub
End If
End If
Next
End Sub
| ReDim Preserve varr(1 To j - 1, 1 To 2)
Si tu utilises "Preserve", seulement la dernière dimension de ton tableau est redimensionnable.
"fetnat" <fetnat@caramail.com> a écrit dans le message de news:
OH2f4SffIHA.2004@TK2MSFTNGP05.phx.gbl...
Bonjour,
Je travaille au corps la macro de T. Ogilvy car les coefficients
négatifs n'étaient pas traités dans la version originale.
La conversion des virgules en points posent un problème si on garde le
caractère x, alors autant l'enlever.
Ma première version était correcte pour des équations du premier degré
mais pour des degré supérieurs, elle ne fonctionnait pas.
La première partie de semble bien remplir le tableau (10x2) pour un degré 4.
Mais je bloque sur le Redim Preserve : Indice en dehors de la plage
(erreur 9)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Une aide serait fortement appréciée pour passer ce point, ce qui me
permettait de mettre au point le vidage du tableau vers les cellules.
Naturellement je vais mettre cette version (au point) dans l'autre fil).
Merci d'avance
fetnat
Sub GetFormula()
'"Tom Ogilvy" : extrait les coef d'une équation (à partir du label du
graphique)
' coeficient supérieur en N6 (et en dessous) et degré en O6
Dim sStr As String, sStr1 As String, sStr2 As String
Dim sFormula As String, j As Long, k As Long
Dim i As Long
Dim ser As Series, sChar As String
Dim tline As Trendline
Dim cht As Chart
Dim rng As Range
Dim varr()
ReDim varr(1 To 10, 1 To 2)
Set cht = ActiveSheet.ChartObjects(1).Chart
For Each ser In cht.SeriesCollection
If ser.Trendlines.Count = 1 Then
Set tline = ser.Trendlines(1)
If tline.DisplayEquation Then
sFormula = tline.DataLabel.Text '<== this gets the
formula
sFormula = Application.Substitute(sFormula, "y = ", "")
sFormula = Application.Substitute(sFormula, ",", ".")
sFormula = Application.Substitute(sFormula, " + ", ",")
sFormula = Application.Substitute(sFormula, " - ", ",-")
Debug.Print sFormula
j = 1
For i = 1 To Len(sFormula) + 1
sChar = Mid(sFormula, i, 1)
If sChar = "," Or i = Len(sFormula) + 1 Then
If i = Len(sFormula) + 1 Then
sStr1 = sStr1 & sChar
End If
varr(j, 1) = sStr1
varr(j, 2) = sStr2
Debug.Print j; varr(j, 1); varr(j, 2)
sStr1 = ""
sStr2 = ""
j = j + 1
Else
If sChar <> "x" Then
sStr1 = sStr1 & sChar
Else
If Mid(sFormula, i + 1, 1) <> "," Then
sStr2 = sStr2 & sChar & Mid(sFormula, i
+ 1, 1)
i = i + 1
Else
sStr2 = sStr2 & sChar
End If
End If
End If
Next
Debug.Print j; varr(j - 1, 1); varr(j - 1, 2)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Set rng = Range("N6")
j = 1
For i = LBound(varr) To UBound(varr)
Debug.Print i; varr(i)
rng(j, 1) = CVar(varr(i, 1))
rng(j, 2) = CVar(varr(i, 2))
Debug.Print j; rng(j)
j = j + 1
Next i
Exit Sub
End If
End If
Next
End Sub
| ReDim Preserve varr(1 To j - 1, 1 To 2)
Si tu utilises "Preserve", seulement la dernière dimension de ton tableau est redimensionnable.
"fetnat" a écrit dans le message de news:
Bonjour,
Je travaille au corps la macro de T. Ogilvy car les coefficients
négatifs n'étaient pas traités dans la version originale.
La conversion des virgules en points posent un problème si on garde le
caractère x, alors autant l'enlever.
Ma première version était correcte pour des équations du premier degré
mais pour des degré supérieurs, elle ne fonctionnait pas.
La première partie de semble bien remplir le tableau (10x2) pour un degré 4.
Mais je bloque sur le Redim Preserve : Indice en dehors de la plage
(erreur 9)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Une aide serait fortement appréciée pour passer ce point, ce qui me
permettait de mettre au point le vidage du tableau vers les cellules.
Naturellement je vais mettre cette version (au point) dans l'autre fil).
Merci d'avance
fetnat
Sub GetFormula()
'"Tom Ogilvy" : extrait les coef d'une équation (à partir du label du
graphique)
' coeficient supérieur en N6 (et en dessous) et degré en O6
Dim sStr As String, sStr1 As String, sStr2 As String
Dim sFormula As String, j As Long, k As Long
Dim i As Long
Dim ser As Series, sChar As String
Dim tline As Trendline
Dim cht As Chart
Dim rng As Range
Dim varr()
ReDim varr(1 To 10, 1 To 2)
Set cht = ActiveSheet.ChartObjects(1).Chart
For Each ser In cht.SeriesCollection
If ser.Trendlines.Count = 1 Then
Set tline = ser.Trendlines(1)
If tline.DisplayEquation Then
sFormula = tline.DataLabel.Text '<== this gets the
formula
sFormula = Application.Substitute(sFormula, "y = ", "")
sFormula = Application.Substitute(sFormula, ",", ".")
sFormula = Application.Substitute(sFormula, " + ", ",")
sFormula = Application.Substitute(sFormula, " - ", ",-")
Debug.Print sFormula
j = 1
For i = 1 To Len(sFormula) + 1
sChar = Mid(sFormula, i, 1)
If sChar = "," Or i = Len(sFormula) + 1 Then
If i = Len(sFormula) + 1 Then
sStr1 = sStr1 & sChar
End If
varr(j, 1) = sStr1
varr(j, 2) = sStr2
Debug.Print j; varr(j, 1); varr(j, 2)
sStr1 = ""
sStr2 = ""
j = j + 1
Else
If sChar <> "x" Then
sStr1 = sStr1 & sChar
Else
If Mid(sFormula, i + 1, 1) <> "," Then
sStr2 = sStr2 & sChar & Mid(sFormula, i
+ 1, 1)
i = i + 1
Else
sStr2 = sStr2 & sChar
End If
End If
End If
Next
Debug.Print j; varr(j - 1, 1); varr(j - 1, 2)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Set rng = Range("N6")
j = 1
For i = LBound(varr) To UBound(varr)
Debug.Print i; varr(i)
rng(j, 1) = CVar(varr(i, 1))
rng(j, 2) = CVar(varr(i, 2))
Debug.Print j; rng(j)
j = j + 1
Next i
Exit Sub
End If
End If
Next
End Sub
Bonjour,
Je travaille au corps la macro de T. Ogilvy car les coefficients
négatifs n'étaient pas traités dans la version originale.
La conversion des virgules en points posent un problème si on garde le
caractère x, alors autant l'enlever.
Ma première version était correcte pour des équations du premier degré
mais pour des degré supérieurs, elle ne fonctionnait pas.
La première partie de semble bien remplir le tableau (10x2) pour un
degré 4.
Mais je bloque sur le Redim Preserve : Indice en dehors de la plage
(erreur 9)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Une aide serait fortement appréciée pour passer ce point, ce qui me
permettait de mettre au point le vidage du tableau vers les cellules.
Naturellement je vais mettre cette version (au point) dans l'autre fil).
Merci d'avance
fetnat
Sub GetFormula()
'"Tom Ogilvy" : extrait les coef d'une équation (à partir du label du
graphique)
' coeficient supérieur en N6 (et en dessous) et degré en O6
Dim sStr As String, sStr1 As String, sStr2 As String
Dim sFormula As String, j As Long, k As Long
Dim i As Long
Dim ser As Series, sChar As String
Dim tline As Trendline
Dim cht As Chart
Dim rng As Range
Dim varr()
ReDim varr(1 To 10, 1 To 2)
Set cht = ActiveSheet.ChartObjects(1).Chart
For Each ser In cht.SeriesCollection
If ser.Trendlines.Count = 1 Then
Set tline = ser.Trendlines(1)
If tline.DisplayEquation Then
sFormula = tline.DataLabel.Text '<== this gets the
formula
sFormula = Application.Substitute(sFormula, "y = ", "")
sFormula = Application.Substitute(sFormula, ",", ".")
sFormula = Application.Substitute(sFormula, " + ", ",")
sFormula = Application.Substitute(sFormula, " - ", ",-")
Debug.Print sFormula
j = 1
For i = 1 To Len(sFormula) + 1
sChar = Mid(sFormula, i, 1)
If sChar = "," Or i = Len(sFormula) + 1 Then
If i = Len(sFormula) + 1 Then
sStr1 = sStr1 & sChar
End If
varr(j, 1) = sStr1
varr(j, 2) = sStr2
Debug.Print j; varr(j, 1); varr(j, 2)
sStr1 = ""
sStr2 = ""
j = j + 1
Else
If sChar <> "x" Then
sStr1 = sStr1 & sChar
Else
If Mid(sFormula, i + 1, 1) <> "," Then
sStr2 = sStr2 & sChar & Mid(sFormula, i
+ 1, 1)
i = i + 1
Else
sStr2 = sStr2 & sChar
End If
End If
End If
Next
Debug.Print j; varr(j - 1, 1); varr(j - 1, 2)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Set rng = Range("N6")
j = 1
For i = LBound(varr) To UBound(varr)
Debug.Print i; varr(i)
rng(j, 1) = CVar(varr(i, 1))
rng(j, 2) = CVar(varr(i, 2))
Debug.Print j; rng(j)
j = j + 1
Next i
Exit Sub
End If
End If
Next
End Sub
Bonjour,
Je travaille au corps la macro de T. Ogilvy car les coefficients
négatifs n'étaient pas traités dans la version originale.
La conversion des virgules en points posent un problème si on garde le
caractère x, alors autant l'enlever.
Ma première version était correcte pour des équations du premier degré
mais pour des degré supérieurs, elle ne fonctionnait pas.
La première partie de semble bien remplir le tableau (10x2) pour un
degré 4.
Mais je bloque sur le Redim Preserve : Indice en dehors de la plage
(erreur 9)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Une aide serait fortement appréciée pour passer ce point, ce qui me
permettait de mettre au point le vidage du tableau vers les cellules.
Naturellement je vais mettre cette version (au point) dans l'autre fil).
Merci d'avance
fetnat
Sub GetFormula()
'"Tom Ogilvy" : extrait les coef d'une équation (à partir du label du
graphique)
' coeficient supérieur en N6 (et en dessous) et degré en O6
Dim sStr As String, sStr1 As String, sStr2 As String
Dim sFormula As String, j As Long, k As Long
Dim i As Long
Dim ser As Series, sChar As String
Dim tline As Trendline
Dim cht As Chart
Dim rng As Range
Dim varr()
ReDim varr(1 To 10, 1 To 2)
Set cht = ActiveSheet.ChartObjects(1).Chart
For Each ser In cht.SeriesCollection
If ser.Trendlines.Count = 1 Then
Set tline = ser.Trendlines(1)
If tline.DisplayEquation Then
sFormula = tline.DataLabel.Text '<== this gets the
formula
sFormula = Application.Substitute(sFormula, "y = ", "")
sFormula = Application.Substitute(sFormula, ",", ".")
sFormula = Application.Substitute(sFormula, " + ", ",")
sFormula = Application.Substitute(sFormula, " - ", ",-")
Debug.Print sFormula
j = 1
For i = 1 To Len(sFormula) + 1
sChar = Mid(sFormula, i, 1)
If sChar = "," Or i = Len(sFormula) + 1 Then
If i = Len(sFormula) + 1 Then
sStr1 = sStr1 & sChar
End If
varr(j, 1) = sStr1
varr(j, 2) = sStr2
Debug.Print j; varr(j, 1); varr(j, 2)
sStr1 = ""
sStr2 = ""
j = j + 1
Else
If sChar <> "x" Then
sStr1 = sStr1 & sChar
Else
If Mid(sFormula, i + 1, 1) <> "," Then
sStr2 = sStr2 & sChar & Mid(sFormula, i
+ 1, 1)
i = i + 1
Else
sStr2 = sStr2 & sChar
End If
End If
End If
Next
Debug.Print j; varr(j - 1, 1); varr(j - 1, 2)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Set rng = Range("N6")
j = 1
For i = LBound(varr) To UBound(varr)
Debug.Print i; varr(i)
rng(j, 1) = CVar(varr(i, 1))
rng(j, 2) = CVar(varr(i, 2))
Debug.Print j; rng(j)
j = j + 1
Next i
Exit Sub
End If
End If
Next
End Sub
Bonjour,
Je travaille au corps la macro de T. Ogilvy car les coefficients
négatifs n'étaient pas traités dans la version originale.
La conversion des virgules en points posent un problème si on garde le
caractère x, alors autant l'enlever.
Ma première version était correcte pour des équations du premier degré
mais pour des degré supérieurs, elle ne fonctionnait pas.
La première partie de semble bien remplir le tableau (10x2) pour un
degré 4.
Mais je bloque sur le Redim Preserve : Indice en dehors de la plage
(erreur 9)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Une aide serait fortement appréciée pour passer ce point, ce qui me
permettait de mettre au point le vidage du tableau vers les cellules.
Naturellement je vais mettre cette version (au point) dans l'autre fil).
Merci d'avance
fetnat
Sub GetFormula()
'"Tom Ogilvy" : extrait les coef d'une équation (à partir du label du
graphique)
' coeficient supérieur en N6 (et en dessous) et degré en O6
Dim sStr As String, sStr1 As String, sStr2 As String
Dim sFormula As String, j As Long, k As Long
Dim i As Long
Dim ser As Series, sChar As String
Dim tline As Trendline
Dim cht As Chart
Dim rng As Range
Dim varr()
ReDim varr(1 To 10, 1 To 2)
Set cht = ActiveSheet.ChartObjects(1).Chart
For Each ser In cht.SeriesCollection
If ser.Trendlines.Count = 1 Then
Set tline = ser.Trendlines(1)
If tline.DisplayEquation Then
sFormula = tline.DataLabel.Text '<== this gets the
formula
sFormula = Application.Substitute(sFormula, "y = ", "")
sFormula = Application.Substitute(sFormula, ",", ".")
sFormula = Application.Substitute(sFormula, " + ", ",")
sFormula = Application.Substitute(sFormula, " - ", ",-")
Debug.Print sFormula
j = 1
For i = 1 To Len(sFormula) + 1
sChar = Mid(sFormula, i, 1)
If sChar = "," Or i = Len(sFormula) + 1 Then
If i = Len(sFormula) + 1 Then
sStr1 = sStr1 & sChar
End If
varr(j, 1) = sStr1
varr(j, 2) = sStr2
Debug.Print j; varr(j, 1); varr(j, 2)
sStr1 = ""
sStr2 = ""
j = j + 1
Else
If sChar <> "x" Then
sStr1 = sStr1 & sChar
Else
If Mid(sFormula, i + 1, 1) <> "," Then
sStr2 = sStr2 & sChar & Mid(sFormula, i
+ 1, 1)
i = i + 1
Else
sStr2 = sStr2 & sChar
End If
End If
End If
Next
Debug.Print j; varr(j - 1, 1); varr(j - 1, 2)
ReDim Preserve varr(1 To j - 1, 1 To 2)
Set rng = Range("N6")
j = 1
For i = LBound(varr) To UBound(varr)
Debug.Print i; varr(i)
rng(j, 1) = CVar(varr(i, 1))
rng(j, 2) = CVar(varr(i, 2))
Debug.Print j; rng(j)
j = j + 1
Next i
Exit Sub
End If
End If
Next
End Sub