Redim Preserve erreur 9

Le
fetnat
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichDenis
Le #5176141
| 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"
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
JB
Le #5176131
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
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


fetnat
Le #5176091
Merci beaucoup JB.

Bonne journée

fetnat

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
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





fetnat
Le #5176081
Merci beaucoup MichDenis.

Bonne journée

fetnat

| 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"
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




fetnat
Le #5176071
Je ne suis pas peu-fier de présenter une version qui traite tout les
degrés de l'équation...

Sub GetFormula()
' d'après "Tom Ogilvy", modifié pour utiliser le séparateur décimal
"virgule"
' extrait les coef d'une équation jusqu'au degré 6 (à partir du label
du graphique)
' le coeficient supérieur est en N6 (coef du degré inférieur en
dessous etc.) et degré en O6
' ATTN : le range ("N6:O12") est utilisé pour une équation de degré 6
Dim sStr As String, sStr1 As String, sStr2 As String
Dim sFormula As String, j 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 7, 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)
Set rng = Range("N6")
j = 1
For i = LBound(varr) To UBound(varr)
'Debug.Print i; varr(i, 1); varr(i, 2)
rng(j, 1) = CVar(varr(i, 1))
rng(j, 2) = CVar(varr(i, 2))
'Debug.Print j; rng(j, 1); rng(j, 2)
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


Publicité
Poster une réponse
Anonyme