问题
This is a follow up on this question.
I'm working on producing a quadratic fit for a plot of data using Excel VBA. As is, when I call linEst, I'm getting the error "Type Mismatch". The one time it did work for me, if the formula for a quadratic equation is Ax^2 + Bx + C, I only got my A and C values to quadSlope and quadB respectively.
I have no idea what caused it to work the first time, so I can't provide much else on attempted solutions aside from the code posted below.
Dim quad() As Variant 'polynomial regression'
Dim nAvg() As Variant 'Avg values being looked at in current loop'
Dim nP2() As Variant 'P2 values being looked at in current loop'
Dim k As Single 'Ratio of RMSE1/RMSE2'
Dim quadEstOut() As Variant
Dim quadSlope As Single
Dim quadB As Single
Dim quadC As Single
ReDim quadEstOut(1 To 3)
For i = 2 To UBound(LaserP)
ReDim Preserve lin(1 To i)
ReDim Preserve quad(1 To i)
ReDim Preserve nAvg(1 To i)
ReDim Preserve nP2(1 To i)
nAvg(1) = Avg(1)
nP2(1) = P2(1)
nAvg(i) = Avg(i)
nP2(i) = P2(i)
'quadratic regression'
quadEstOut = Application.LinEst(nAvg, Application.Power(nP2, Array(1, 2)))
quadSlope = quadEstOut(1)
quadB = quadEstOut(2)
quadC = quadEstOut(3)
For j = 1 To UBound(quad)
quad(j) = (quadSlope * nP2(i) ^ 2) + (quadB * nP2(i)) + quadC
Next j
Next i
I'm looking for linEst to return the A,B, and C coefficients.
Thank you.
回答1:
Your issue is that if LinEst for a given data set returns an error, it cannot be assigned to your quadEstOut variable because that variable is Dim'd as a variant Array.
To fix taht issue, change to this:
'...
Dim quadEstOut as Variant
'...
'You don't need this, LinEst will override it anyway
'ReDim quadEstOut(1 To 3)
'...
'Get you fit
quadEstOut = Application.LinEst(nAvg, Application.Power(nP2, Array(2, 1)))
'Check for error
If IsError(quadEstOut) Then
' LinEst failed, what now?
Else
' rest of your code
End If
Note that I changed Array(1, 2) to Array(2, 1). As it was you are swapping the A and B coefficients.
Note that are are many other issues in your code. I've limited this answer to address the question asked.
回答2:
If the size of the dataset is relatively small, it might be better to avoid using LinEst altogether and code the function yourself for more flexibility. The reason why I'm suggesting using this only with a small dataset is because it will require a few large matrix inversion which can take a lot of time to perform in VBA.
Let's say that you have the following data with "Y" being in cell "A1"
Y X E
4534.6338 46.87 0.43
5600.2078 52.17 0.28
4688.4378 47.67 0.57
5758.1662 52.91 0.50
3495.2072 41.06 0.18
3328.3850 40.05 0.23
4305.5050 45.65 0.71
3706.3000 42.30 0.82
3589.7988 41.62 0.49
3890.6092 43.36 0.35
4178.5832 44.96 0.90
5049.7600 49.50 0.76
2864.8500 37.10 0.73
6077.8388 54.38 0.33
5581.5428 52.08 0.65
3653.0802 41.99 0.79
5981.6972 53.94 0.83
2925.7900 37.50 0.79
3284.7968 39.78 0.56
3311.8850 39.95 0.03
2945.5438 37.63 0.62
4603.1758 47.23 0.14
3655.7702 42.01 0.06
3353.0900 40.20 0.41
4638.4962 47.41 0.85
4018.8328 44.08 0.50
4134.5368 44.72 0.62
4993.1768 49.22 0.30
6623.0000 56.80 0.12
4860.1850 48.55 0.33
6401.9878 55.83 0.52
5966.3138 53.87 0.75
4260.7062 45.41 0.34
4567.1832 47.04 0.54
4752.7700 48.00 0.77
6255.4448 55.18 0.24
4776.4088 48.12 0.98
6409.1892 55.86 0.93
4907.5182 48.79 0.22
3614.8458 41.77 0.07
3832.4618 43.03 0.21
2919.8532 37.46 0.97
3608.9558 41.73 0.98
3557.2998 41.43 0.12
4110.6662 44.59 0.36
4443.2342 46.39 0.00
6128.7542 54.61 0.42
4931.7462 48.91 0.64
6207.0832 54.96 1.00
3358.2158 40.23 0.62
3473.9498 40.93 0.63
4949.4300 49.00 0.43
4732.9700 47.90 0.45
3600.3048 41.68 0.82
5933.4868 53.72 0.65
3199.6750 39.25 0.80
5326.5192 50.86 0.46
3450.6282 40.79 0.61
4801.6150 48.25 0.74
In this case our quadratic equation of form Y = AX^2 + BX + C + E has the following parametrisation:
Where E is the error that we don't observe and can't be explained by our linear model of Y = AX^2 + BX + C.
We could estimate the model using the following VBA procedure:
Sub OrdinaryLeastSquareEstimation()
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim ws As Worksheet
Set ws = wb.ActiveSheet
Dim y() As Variant 'Independent variable
y = ws.Range(ws.Cells(2, 1), ws.Cells(2, 1).End(xlDown))
Dim x() As Variant 'Dependant variable
x = ws.Range(ws.Cells(2, 2), ws.Cells(2, 2).End(xlDown))
'Define regression parameters
Dim n As Long
n = UBound(x, 1)
Dim p As Long 'Degree of the polynomial (customizable)
p = 2
'Generate the X matrix by putting our regressors side-by-side (ie. the constant = 1 = x^0, x, x^2, etc.)
Dim Xmat() As Double
ReDim Xmat(1 To n, 1 To p + 1)
Dim i As Long
Dim j As Long
For i = 1 To n
For j = 1 To p + 1
Xmat(i, j) = x(i, 1) ^ (j - 1)
Next j
Next i
'Calculate the estimator vector
Dim temp1() As Variant
Dim temp2() As Variant
Dim beta As Variant
temp1 = Application.MInverse(Application.MMult(Application.Transpose(Xmat), Xmat))
temp2 = Application.MMult(Application.Transpose(Xmat), y)
beta = Application.WorksheetFunction.MMult(temp1, temp2)
'Create equation to display
Dim eqt As String
Dim NbDigit As Long
NbDigit = 4
If beta(1, 1) > 0 Then
eqt = "+" & Round(beta(1, 1), NbDigit)
Else
eqt = Round(beta(1, 1), NbDigit)
End If
For j = 2 To p + 1
If beta(j, 1) > 0 Then
eqt = "+" & Round(beta(j, 1), NbDigit) & "*X^" & (j - 1) & eqt
ElseIf beta(j, 1) < 0 Then
eqt = Round(beta(j, 1), NbDigit) & "*X^" & (j - 1) & eqt
End If
Next
If Left(eqt, 1) = "+" Then eqt = Right$(eqt, Len(eqt) - 1)
MsgBox "Estimated Equation:" & vbNewLine & eqt
End Sub
And you should get the following, which is pretty close the parameters from our model.
Method used
The code above uses the general matrix formula to calculate the Ordinary Least Squared estimate, which is the method used by the LinEst function as well:
More details
Customization
- You could customize the variable p to be any integer which allows for any polynomial order.
- You can use the vector
betathat contain to access the resulting coefficients from the regression. Make sure to use 2D references as it's a vector stored as a matrix of dimension p+1 by 1.
来源：https://stackoverflow.com/questions/57717645/type-mismatch-and-expected-values-missing-when-using-the-linest-function-in-vba