Code VBA régression exponentielle

Question

Bonjour à tous,

Je sèche sur un problème de code VBA.

Je souhaite obtenir un tableau avec les valeur de a et de b de mon équation de courbe exponentielle.
Mes données sont dans la colonne I pour les y-valeurs et X pur les x-valeurs.

J'ai essayé ce code mais cela me met un message d'erreur #valeur!

Function ExpRegressionV2(x As Range, y As Range) As Variant

Dim i As Long

Dim count As Long

Dim newX() As Double

Dim lnY() As Double

Dim linEstResults As Variant

' Vérifier que les plages ont la même taille

If x.Rows.count <> y.Rows.count Then

    ExpRegressionV2 = CVErr(xlErrRef)

    Exit Function

End If

' Initialiser les tableaux pour les valeurs ln(y) et x

count = x.Rows.count

ReDim newX(1 To count)

ReDim lnY(1 To count)

' Remplir les tableaux avec les valeurs de x et ln(y)

For i = 1 To count

    If IsNumeric(x.Cells(i, 1).Value) And IsNumeric(y.Cells(i, 1).Value) Then

        If y.Cells(i, 1).Value > 0 Then

            newX(i) = x.Cells(i, 1).Value

            lnY(i) = Log(y.Cells(i, 1).Value) ' Transformation en ln(y)

        Else

            ExpRegressionV2 = CVErr(xlErrNum) ' Erreur si y <= 0

            Exit Function

        End If

    Else

        ExpRegressionV2 = CVErr(xlErrValue) ' Erreur si valeurs non numériques

        Exit Function

    End If

Next i

' Appliquer une régression linéaire sur x et ln(y)

On Error Resume Next

linEstResults = WorksheetFunction.LinEst(lnY, newX, True, True)

On Error GoTo 0

' Vérifier si LinEst a échoué

If IsEmpty(linEstResults) Then

    ExpRegressionV2 = CVErr(xlErrNum)

    Exit Function

End If

' Extraire les coefficients pour y = a \* e^(b \* x)

Dim a As Double, b As Double

b = linEstResults(1) ' Pente

a = Exp(linEstResults(2)) ' Transformation de l'interception pour obtenir a

' Retourner les coefficients dans un tableau

Dim results(1 To 2) As Double

results(1) = a ' Coefficient a

results(2) = b ' Coefficient b

ExpRegressionV2 = results

End Function

Avez-vous une solution ?

Cordialement,
Agathe

Answer 1

Ca fonctionne ici :

Daniel

Answer 2

Bonjour,
Merci de votre message j'ai bien 2 valeurs obtenues malheureusement ce ne sont pas celle affichées sur l'équation de la courbe y = 15.549e(0.2923)x. L'objectif est de récupérer ces valeurs 15.549 & 0.2923 automatiquement.

Mes données X : 8.19 ; 7; ""; 5.56; 4.33

Mes données Y : 196; 102; 84.50; 72.50; 61.50

Merci cordialement

Answer 3

Bonjour,

Merci de votre réponse mais cela ne fonctionne pas j'ai le même message d'erreur

Answer 4

Bonjour,

Si tu ne veux que a et b c'est plus

linEstResults = WorksheetFunction.LinEst(lnY, newX, True, False)

Sinon ce n'est plus un tableau à une dimension

Answer 5

Bonjour,

Essaie :

Function ExpRegressionV2(x As Range, y As Range) As Variant
Dim i As Long
Dim count As Long
Dim newX() As Double
Dim lnY() As Double
Dim linEstResults As Variant
' Vérifier que les plages ont la même taille
If x.Rows.count <> y.Rows.count Then
ExpRegressionV2 = CVErr(xlErrRef)
Exit Function
End If
' Initialiser les tableaux pour les valeurs ln(y) et x
count = x.Rows.count
ReDim newX(1 To count)
ReDim lnY(1 To count)
' Remplir les tableaux avec les valeurs de x et ln(y)
For i = 1 To count
If IsNumeric(x.Cells(i, 1).Value) And IsNumeric(y.Cells(i, 1).Value) Then
If y.Cells(i, 1).Value > 0 Then
newX(i) = x.Cells(i, 1).Value
lnY(i) = Log(y.Cells(i, 1).Value) ' Transformation en ln(y)
Else
ExpRegressionV2 = CVErr(xlErrNum) ' Erreur si y <= 0
Exit Function
End If
Else
ExpRegressionV2 = CVErr(xlErrValue) ' Erreur si valeurs non numériques
Exit Function
End If
Next i
' Appliquer une régression linéaire sur x et ln(y)
On Error Resume Next
linEstResults = WorksheetFunction.LinEst(lnY, newX, True, True)
On Error GoTo 0
' Vérifier si LinEst a échoué
If IsEmpty(linEstResults) Then
ExpRegressionV2 = CVErr(xlErrNum)
Exit Function
End If
' Extraire les coefficients pour y = a * e^(b * x)
Dim a As Double, b As Double
b = linEstResults(1, 1) ' Pente
a = Exp(linEstResults(2, 1)) ' Transformation de l'interception pour obtenir a
' Retourner les coefficients dans un tableau
Dim results(1 To 2) As Double
results(1) = a ' Coefficient a
results(2) = b ' Coefficient b
ExpRegressionV2 = results
End Function

Daniel