Skip to content

Commit 81c6651

Browse files
ws-garciaws-garcia
committed
Update VBAexpressions.cls
1 parent 16b678a commit 81c6651

File tree

1 file changed

+92
-29
lines changed

1 file changed

+92
-29
lines changed

‎src/VBAexpressions.cls‎

Lines changed: 92 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -308,7 +308,7 @@ Private Sub Class_Initialize()
308308
AssignedExpression = False
309309
pi = 4 * Atn(1)
310310
PID2 = pi / 2
311-
e = exp(1)
311+
e = Exp(1)
312312
P_SEPARATORCHAR = d_Semicolon
313313
P_DEC_SYMBOL = dsDot
314314
AscDecSymbol = 46
@@ -1660,10 +1660,10 @@ Private Function BETAINV_(p As Double, A As Double, B As Double) As Double
16601660
H = 2 / (1 / (2 * A - 1) + 1 / (2 * B - 1))
16611661
w = (x * Sqr(aL + H) / H) - (1 / (2 * B - 1) - 1 / (2 * A - 1)) * _
16621662
(aL + 5 / 6 - 2 / (3 * H))
1663-
x = A / (A + B * exp(2 * w))
1663+
x = A / (A + B * Exp(2 * w))
16641664
Else
16651665
lna = Log(A / (A + B)): lnb = Log(B / (A + B))
1666-
t = exp(A * lna) / A: u = exp(B * lnb) / B
1666+
t = Exp(A * lna) / A: u = Exp(B * lnb) / B
16671667
w = t + u
16681668
If p < t / w Then
16691669
x = (A * w * p) ^ (1 / A)
@@ -1675,7 +1675,7 @@ Private Function BETAINV_(p As Double, A As Double, B As Double) As Double
16751675
Do While j < 10
16761676
If x = 0 Or x = 1 Then BETAINV_ = x: Exit Function
16771677
err = iBETA_(x, A, B) - p
1678-
t = exp(a1 * Log(x) + b1 * Log(1 - x) + afac)
1678+
t = Exp(a1 * Log(x) + b1 * Log(1 - x) + afac)
16791679
u = err / t
16801680
t = u / (1 - 0.5 * MIN_(1, u * (a1 / x - b1 / (1 - x))))
16811681
x = x - t
@@ -1743,7 +1743,7 @@ Private Function BETALN_(x As Double, y As Double) As Double
17431743
End Function
17441744

17451745
Private Function BETAPDF_(x As Double, Alpha As Double, Beta As Double) As Double
1746-
BETAPDF_ = exp((Alpha - 1) * Log(x) + (Beta - 1) * Log(1 - x) - BETALN_(Alpha, Beta))
1746+
BETAPDF_ = Exp((Alpha - 1) * Log(x) + (Beta - 1) * Log(1 - x) - BETALN_(Alpha, Beta))
17471747
End Function
17481748

17491749
Private Function BETAPDF_EXCEL(x As Double, Alpha As Double, _
@@ -2015,7 +2015,7 @@ Private Function CHISQ_(x As Double, n As Double) As Double
20152015
CHISQ_ = 1 - q: Exit Function
20162016
End If
20172017
End If
2018-
p = exp(-0.5 * x)
2018+
p = Exp(-0.5 * x)
20192019
If (REM_(n, 2) = 1) Then
20202020
p = p * Sqr(2 * x / pi)
20212021
End If
@@ -2438,14 +2438,39 @@ err_Handler:
24382438
d_lParenthesis & err.Description & d_rParenthesis
24392439
End Function
24402440

2441+
Private Function GetLiteralStringGap(startPos As Long, ByRef expression As String) As Long()
2442+
Dim literalStrGap() As Long
2443+
Dim tmpPos As Long
2444+
ReDim literalStrGap(0 To 1)
2445+
2446+
tmpPos = InStr(startPos, expression, d_Apostrophe)
2447+
If tmpPos Then
2448+
literalStrGap(0) = tmpPos
2449+
literalStrGap(1) = InStr(tmpPos + 1, expression, d_Apostrophe)
2450+
End If
2451+
GetLiteralStringGap = literalStrGap
2452+
End Function
24412453
Private Function CountParentheses(ByRef expression As String, ByRef ParenthesisChar As String) As Long
24422454
Dim tmpResult As Long
24432455
Dim SearchIndex As Long
24442456
Dim OpenedClosedP As Long
2457+
Dim literalStrGap() As Long
2458+
Dim foundLiteralStrGap As Boolean
24452459

24462460
OpenedClosedP = InStrB(1, expression, ParenthesisChar)
2461+
literalStrGap() = GetLiteralStringGap(1, expression)
24472462
Do While OpenedClosedP
2448-
tmpResult = tmpResult + 1
2463+
foundLiteralStrGap = (literalStrGap(0) > 0 And literalStrGap(1) > 0)
2464+
If foundLiteralStrGap Then
2465+
If Not (OpenedClosedP > 2 * literalStrGap(0) And OpenedClosedP < 2 * literalStrGap(1)) Then
2466+
tmpResult = tmpResult + 1
2467+
If SearchIndex > 2 * literalStrGap(1) * 2 Then
2468+
literalStrGap() = GetLiteralStringGap(literalStrGap(1) + 1, expression)
2469+
End If
2470+
End If
2471+
Else
2472+
tmpResult = tmpResult + 1
2473+
End If
24492474
SearchIndex = OpenedClosedP + 2
24502475
OpenedClosedP = InStrB(SearchIndex, expression, ParenthesisChar)
24512476
Loop
@@ -3129,7 +3154,7 @@ End Sub
31293154

31303155
Private Function ExpEuler(ByRef expression As String, ByRef fName As String) As String
31313156
On Error GoTo err_Handler
3132-
ExpEuler = CStr(exp(CDbl(expression)))
3157+
ExpEuler = CStr(Exp(CDbl(expression)))
31333158
Exit Function
31343159
err_Handler:
31353160
ExpEuler = e_ValueError
@@ -3319,7 +3344,7 @@ Private Function Fit(ByRef expression As String, ByRef fName As String) As Strin
33193344
Select Case fittingOption
33203345
Case 2 'Exponential [y = a*e^(b*x)]
33213346
solverCoeff(0, 0) = 10 ^ solverCoeff(0, 0) 'antilog_10 (A)
3322-
solverCoeff(1, 0) = solverCoeff(1, 0) / Log10(exp(1)) 'B/log10(e)
3347+
solverCoeff(1, 0) = solverCoeff(1, 0) / Log10(Exp(1)) 'B/log10(e)
33233348
Case 3 'Exponential [y = a*b^x]
33243349
solverCoeff(0, 0) = 10 ^ solverCoeff(0, 0) 'antilog_10 (A)
33253350
solverCoeff(1, 0) = 10 ^ solverCoeff(1, 0) 'antilog_10 (B)
@@ -3604,6 +3629,7 @@ Private Function fZeroMBM(ByRef aFunction As String, ByVal A As Double, _
36043629
aZero = 10 * epsilon
36053630
With fEvalHelper
36063631
.Create aFunction
3632+
.GallopingMode = False
36073633
tmpVar() = Split(.CurrentVariables, "; ")
36083634
varLB = LBound(tmpVar)
36093635
If UBound(tmpVar) - varLB > 0 Then 'Reject multivariate functions
@@ -3720,6 +3746,7 @@ Private Function fZeroMRF(ByRef aFunction As String, ByVal A As Double, _
37203746
Set fEvalHelper = New VBAexpressions
37213747
aZero = 10 * epsilon
37223748
With fEvalHelper
3749+
.GallopingMode = False
37233750
.Create aFunction
37243751
tmpVar() = Split(.CurrentVariables, "; ")
37253752
varLB = LBound(tmpVar)
@@ -4347,12 +4374,28 @@ Private Function GetLParentPos(ByRef expression As String, ByRef RelativePositio
43474374
Dim SearchIndex As Long
43484375
Dim OpenedP As Long
43494376
Dim tmpResult As Long
4377+
Dim literalStrGap() As Long
4378+
Dim foundLiteralStrGap As Boolean
43504379

4380+
literalStrGap() = GetLiteralStringGap(1, expression)
4381+
foundLiteralStrGap = (literalStrGap(0) > 0 And literalStrGap(1) > 0)
43514382
OpenedP = InStrB(1, expression, d_lParenthesis)
4383+
If foundLiteralStrGap Then
4384+
Do While OpenedP And (OpenedP > literalStrGap(0) * 2 _
4385+
And OpenedP < literalStrGap(1) * 2)
4386+
OpenedP = InStrB(1, expression, d_lParenthesis)
4387+
Loop
4388+
End If
43524389
Do While tmpCounter < RelativePosition
43534390
tmpCounter = tmpCounter + 1
43544391
SearchIndex = OpenedP + 2
4355-
tmpResult = OpenedP
4392+
If SearchIndex > literalStrGap(1) * 2 And foundLiteralStrGap Then
4393+
literalStrGap() = GetLiteralStringGap(1, expression)
4394+
foundLiteralStrGap = (literalStrGap(0) > 0 And literalStrGap(1) > 0)
4395+
End If
4396+
If Not (OpenedP > literalStrGap(0) * 2 And OpenedP < literalStrGap(1) * 2) Then
4397+
tmpResult = OpenedP
4398+
End If
43564399
OpenedP = InStrB(SearchIndex, expression, d_lParenthesis)
43574400
Loop
43584401
GetLParentPos = tmpResult
@@ -4636,29 +4679,49 @@ Private Function GetRParentPos(ByRef expression As String, ByRef index As Long)
46364679
Dim SearchIndex As Long
46374680
Dim OpenedSum As Long
46384681
Dim tmpChr As String
4682+
Dim literalStrGap() As Long
4683+
ReDim literalStrGap(0 To 1)
4684+
Dim foundLiteralStrGap As Boolean
46394685

46404686
SearchIndex = 1
46414687
OpenedSum = 0
4688+
literalStrGap() = GetLiteralStringGap(1, expression)
4689+
foundLiteralStrGap = (literalStrGap(0) > 0 And literalStrGap(1) > 0)
46424690
Do
4643-
tmpChr = MidB$(expression, SearchIndex, 2)
4644-
If tmpChr = d_lParenthesis Then
4645-
OpenedSum = OpenedSum + 1
4691+
If Not (SearchIndex > literalStrGap(0) * 2 And SearchIndex < literalStrGap(1) * 2) Then
4692+
tmpChr = MidB$(expression, SearchIndex, 2)
4693+
If tmpChr = d_lParenthesis Then
4694+
OpenedSum = OpenedSum + 1
4695+
Else
4696+
If tmpChr = d_rParenthesis Then
4697+
OpenedSum = OpenedSum - 1
4698+
End If
4699+
End If
46464700
Else
4647-
If tmpChr = d_rParenthesis Then
4648-
OpenedSum = OpenedSum - 1
4701+
If SearchIndex > literalStrGap(1) * 2 And foundLiteralStrGap Then
4702+
literalStrGap() = GetLiteralStringGap(literalStrGap(1) + 1, expression)
4703+
foundLiteralStrGap = (literalStrGap(0) > 0 And literalStrGap(1) > 0)
46494704
End If
46504705
End If
46514706
SearchIndex = SearchIndex + 2
46524707
Loop While SearchIndex <= index
46534708
SearchIndex = 1
46544709
tmpCounter = 0
4710+
literalStrGap() = GetLiteralStringGap(1, expression)
46554711
Do
4656-
tmpChr = MidB$(expression, SearchIndex, 2)
4657-
If tmpChr = d_lParenthesis Then
4658-
tmpCounter = tmpCounter + 1
4712+
If Not (SearchIndex > literalStrGap(0) * 2 And SearchIndex < literalStrGap(1) * 2) Then
4713+
tmpChr = MidB$(expression, SearchIndex, 2)
4714+
If tmpChr = d_lParenthesis Then
4715+
tmpCounter = tmpCounter + 1
4716+
Else
4717+
If tmpChr = d_rParenthesis Then
4718+
tmpCounter = tmpCounter - 1
4719+
End If
4720+
End If
46594721
Else
4660-
If tmpChr = d_rParenthesis Then
4661-
tmpCounter = tmpCounter - 1
4722+
If SearchIndex > literalStrGap(1) * 2 And foundLiteralStrGap Then
4723+
literalStrGap() = GetLiteralStringGap(literalStrGap(1) + 1, expression)
4724+
foundLiteralStrGap = (literalStrGap(0) > 0 And literalStrGap(1) > 0)
46624725
End If
46634726
End If
46644727
SearchIndex = SearchIndex + 2
@@ -5086,10 +5149,10 @@ Private Function iBETAINV(p As Double, A As Double, B As Double) As Double
50865149
H = 2 / (1 / (2 * A - 1) + 1 / (2 * B - 1))
50875150
w = (x * Sqr(aL + H) / H) - (1 / (2 * B - 1) - 1 / (2 * A - 1)) * _
50885151
(aL + 5 / 6 - 2 / (3 * H))
5089-
x = A / (A + B * exp(2 * w))
5152+
x = A / (A + B * Exp(2 * w))
50905153
Else
50915154
lna = Log(A / (A + B)): lnb = Log(B / (A + B))
5092-
t = exp(A * lna) / A: u = exp(B * lnb) / B
5155+
t = Exp(A * lna) / A: u = Exp(B * lnb) / B
50935156
w = t + u
50945157
If p < t / w Then
50955158
x = (A * w * p) ^ (1 / A)
@@ -5101,7 +5164,7 @@ Private Function iBETAINV(p As Double, A As Double, B As Double) As Double
51015164
Do While j < 10
51025165
If x = 0 Or x = 1 Then iBETAINV = x: Exit Function
51035166
err = iBETA_(x, A, B) - p
5104-
t = exp(a1 * Log(x) + b1 * Log(1 - x) + afac)
5167+
t = Exp(a1 * Log(x) + b1 * Log(1 - x) + afac)
51055168
u = err / t
51065169
t = u / (1 - 0.5 * MIN_(1, u * (a1 / x - b1 / (1 - x))))
51075170
x = x - t
@@ -5120,7 +5183,7 @@ Private Function iBETA_(x As Double, A As Double, B As Double) As Variant
51205183
If x = 0 Or x = 1 Then
51215184
BT = 0
51225185
Else
5123-
BT = exp(GAMMALN_(A + B) - GAMMALN_(A) - GAMMALN_(B) + A * Log(x) + B * Log(1 - x))
5186+
BT = Exp(GAMMALN_(A + B) - GAMMALN_(A) - GAMMALN_(B) + A * Log(x) + B * Log(1 - x))
51245187
End If
51255188
If x < 0 Or x > 1 Then
51265189
iBETA_ = False: Exit Function
@@ -7037,7 +7100,7 @@ Private Function NORM_(z As Double) As Double
70377100
Dim q As Double
70387101
q = z * z
70397102
If (Abs(z) > 7) Then
7040-
NORM_ = (1 - 1 / q + 3 / (q * q)) * exp(-q / 2) / (Abs(z) * Sqr(PID2))
7103+
NORM_ = (1 - 1 / q + 3 / (q * q)) * Exp(-q / 2) / (Abs(z) * Sqr(PID2))
70417104
Else
70427105
NORM_ = CHISQ_(q, 1)
70437106
End If
@@ -9063,16 +9126,16 @@ End Function
90639126

90649127
Private Function ValidFuntionName(ByRef expression As String, _
90659128
ByRef FuntionName As String, _
9066-
StartPos As Long) As Boolean
9129+
startPos As Long) As Boolean
90679130
Dim cLeft As Boolean
90689131
Dim cRight As Boolean
90699132

9070-
If StartPos > 1 Then
9071-
cLeft = Not IsLetter(MidB$(expression, StartPos - 2, 2))
9133+
If startPos > 1 Then
9134+
cLeft = Not IsLetter(MidB$(expression, startPos - 2, 2))
90729135
Else
90739136
cLeft = True
90749137
End If
9075-
cRight = Not IsLetter(MidB$(expression, StartPos + LenB(FuntionName), 2))
9138+
cRight = Not IsLetter(MidB$(expression, startPos + LenB(FuntionName), 2))
90769139
ValidFuntionName = cLeft And cRight
90779140
End Function
90789141

0 commit comments

Comments
 (0)