The VBAexpressions class serves as an intermediary between user interfaces and the main VBA/custom functions exposed through it. The main objective of the development of the class is to demonstrate that all mathematical expressions can be evaluated computationally using an approach similar to the one we humans use: divide the function into sub-expressions, create a symbolic string (lambda) to draw the evaluation flow of the expression, split the sub-expressions into chunks of operations (tokens) by tokenization, evaluate all the tokens.
Introduction
The natural evolution of CSV Interface required the integration of a kind of mathematical expressions evaluator that would make it possible to filter CSV files with a considerable number of records. Nevertheless, this peculiar utility is little developed in VBA language, existing alternatives not very flexible and of difficult integration, as well as others unable to evaluate correctly some corner cases. This limitation put me on the way to develop an evaluator that meets the necessary requirements and at the same time can be integrated with a minimum amount of code in the target library.
Pursued Goals
The utility is required to meet the following requirements:
- The tool must be able to receive a text string as input and return the result obtained by executing the arithmetic, logical and binary relations operations contained in the expression.
- The user must be able to define the variables and decide the value used in each evaluation after parsing the expression.
- Built-in functions must be provided.
- The user must be able to register, at run time, and use his own functions without the need to append code to the developed tool.
- The variables found in each parsed expression, as well as the values relative to them, must be exposed to the user.
- The tool should avoid the use of hard-coded expressions, so variable values should be assigned as text strings.
The Road Way
The traditional way to evaluate mathematical expressions involves the conversion of infix expressions (operands separated by an operator) to postfix. In this way, the evaluation is performed using stacks, or parsed tree, which ensure the precedence of the operators defined in the mathematical expressions.
However, it has been decided to develop VBA Expressions as a tool that is able to evaluate infix expressions directly, although the difficulty is overwhelming, in order to demonstrate that the way humans evaluate an expression is adequate and relatively efficient. The analysis process, prior to evaluation, consists of the creation of an evaluation tree through the following steps:
- The expression is subdivided into related subexpressions using mathematical operators.
- Each subexpression is divided into tokens, each of which is defined by 2 arguments related by a mathematical operator.
- A token is created and stored for each subexpression.
- Each token is disaggregated into arguments, the lowest level of logic used, represented by a list, a variable or an operand.
- Once all tokens are parsed, the evaluation tree is complete.
The evaluation process follows the following path:
- The parser uses the first token in the evaluation tree as the entry point.
- All arguments of the token are then evaluated.
- The result of the token evaluation is saved.
- Evaluation continues until all tokens are evaluated.
- The evaluation result always corresponds to the last token evaluation.
The VBA Expressions methodology uses parentheses as entry points to tokenize expressions, so the tool allows some interesting hacks among which we can mention the support of arrays defined as text strings with a syntax similar to the one used by Java. Thus, parentheses are characters exclusively reserved for grouping subexpressions that must be evaluated as individual tokens, thus providing a way to evaluate highly complex expressions.
The grammar defining the expressions supported by the utility is shown below:
Expression = ([{"("}] SubExpr [{Operator [{"("}] SubExpr
[{")"}]}] [{")"}] | {["("] ["{"] List [{";" List}] ["}"] [")"]}
SubExpr = Token [{Operator Token}]
Token = [{Unary}] Argument [(Operator | Function) ["("] [{Unary}] [Argument] [")"]]
Argument = (List | Variable | Operand)
List = "{" ["{"] SubExpr [{";" SubExpr}] ["}"] "}"
Unary = "-" | "+" | ~
Operand = ({Digit} ["."] [{Digit}] ["E"("-" | "+"){Digit}] | (True | False))
Variable = Alphabet [{Decimal}] [{(Digit | Alphabet)}]
Alphabet = "A-Z" | "a-z"
Decimal = "."
Digit = "0-9"
Operator = "+" | "-" | "*" | "/" | "\" | "^" | "%" | "!" | "<" | "<=" |
"<>" | ">" | ">=" | "=" | "&" | "|" | "||"
Function = "abs" | "sin" | "cos" | "min" |...|[UDF]
The precedence of the supported operators, as well as the operators themselves, are hard coded in the utility, so, so far, it is not possible to add new operators. The utility will prioritize the evaluation of operators according to the PEMDAS methodology:
1. () Grouping: evaluates functions arguments as well.
2. ! - + Unary operators: exponentiation is the only operation that violates this.
Ex.: `-2 ^ 2 = -4 | (-2)^ 2 = 4.
3. ^ Exponentiation: Although Excel and Matlab evaluate nested exponentiations
from left to right, Google, mathematicians and several modern
programming languages, such as Perl, Python and Ruby, evaluate this
operation from right to left. VBA expressions also evals in Python way:
a^b^c = a^(b^c).
4. \* / % Multiplication, division, modulo: from left to right.
5. + - Addition and subtraction: from left to right.
6. < <= <> >= = > Binary relations.
7. ~ Logical negation.
8. & Logical AND.
9. || Logical XOR.
10. | Logical OR.
It should be noted that VBA does not allow the use of code reflection, so extensibility is limited to the CallByName
function. In order to limit the use of hard-coded arguments, user-defined functions must accept a single variant type parameter, the function will receive a one-dimensional array of text strings with as many elements as arguments have been found when parsing the given expression.
The Code
The heart of the evaluations carried out by VBA Expressions lies in the Parse
method, which is responsible for generating the evaluation tree. A fundamental aspect of this process is the differentiation between simple and compound expressions. A simple expression, in the eyes of the tool, is one that does not make use of parentheses and results in a single evaluation tree. For compound expressions, it is necessary to create as many evaluation trees as subexpressions are present in the expression. Here the code:
Private Sub Parse(ByRef Expression As String)
Dim lambdaText As String
Dim meLB As Long
Dim meUB As Long
Dim meCounter As Long
Dim SimpleExpr As Boolean
Dim TreeUB As Long
Dim LbrCount As Long
Dim RbrCount As Long
On Error GoTo Parse_errHandler
InitializeErrHandler
LbrCount = CountParentheses(Expression, d_lParenthesis)
RbrCount = CountParentheses(Expression, d_rParenthesis)
If LbrCount <> RbrCount Then
Exit Sub
End If
err.Clear
SubTreeData() = GetSubTreeData(Expression)
lambdaText = SerializeSubTree(Expression, SubTreeData)
meLB = LBound(SubTreeData)
meUB = UBound(SubTreeData)
SimpleExpr = (meUB - meLB = 0 And lambdaText = SubTreeData(meUB))
TreeUB = meUB + Abs(CLng(Not SimpleExpr))
ReDim EvalTree(meLB To TreeUB)
For meCounter = meLB To TreeUB
InitBuffer EvalTree(meCounter)
If meCounter < TreeUB Then
TokenizeSubExpr SubTreeData(meCounter), SubTreeData, EvalTree(meCounter)
Else
If Not SimpleExpr Then
TokenizeSubExpr lambdaText, SubTreeData, EvalTree(meCounter)
Else
TokenizeSubExpr SubTreeData(meCounter), SubTreeData, EvalTree(meCounter)
End If
End If
ShrinkBuffer EvalTree(meCounter)
Next meCounter
If ValidTree Then
GeneratedTree = True
Else
GeneratedTree = False
End If
End Sub
Each subexpression is tokenized or subdivided into its fundamental components using the TokenizeSubExpr
method. Here, the differentiation is made between regular subexpressions, argument lists and arrays.
Private Sub TokenizeSubExpr(ByRef Expression As String, _
ByRef SubExpressionsData() As String, ByRef outBuffer As ClusterTree)
Dim tmpReplacement As String
Dim ExpCopy As String
Dim tmpArgs() As String
Dim taIcounter As Long
Dim OperationIndex As Long
Dim tmpIndex As Long
tmpIndex = UBound(SubExpressionsData) + 1
OperationIndex = tmpIndex
ExpCopy = Expression
tmpReplacement = GetSubstStr(OperationIndex)
If Not ExpCopy Like "*{{*}}*" Then
Select Case InStrB(1, ExpCopy, P_SEPARATORCHAR)
Case 0
GetRootedTree ExpCopy, tmpReplacement, OperationIndex, outBuffer
outBuffer.CompCluster = False
Case Else
tmpArgs() = Split(ExpCopy, P_SEPARATORCHAR)
For taIcounter = LBound(tmpArgs) To UBound(tmpArgs)
GetRootedTree tmpArgs(taIcounter), tmpReplacement, _
OperationIndex, outBuffer
Next taIcounter
outBuffer.CompCluster = True
outBuffer.CompArrCluster = False
End Select
Else
outBuffer.ClusterArrBounds = SplitArrBranch(ExpCopy, tmpArgs)
If outBuffer.ClusterArrBounds(0) <> -1 Then
For taIcounter = LBound(tmpArgs) To UBound(tmpArgs)
GetRootedTree tmpArgs(taIcounter), tmpReplacement, OperationIndex, outBuffer
Next taIcounter
outBuffer.CompCluster = True
outBuffer.CompArrCluster = True
Else
End If
End If
End Sub
The GetRootedTree
method extracts all binary operations on the tokens until they are reduced to a single argument.
Private Sub GetRootedTree(ByRef SubExpression As String, ByRef tmpReplacement As String, _
ByRef OperationIndex As Long, ByRef outBuffer As ClusterTree)
Dim vToken As Token
Dim switch As Boolean
Dim tmpPos As Long
Dim OperandInBundle As Boolean
Dim PrevChar As String
Do
SubExpression = ApplyLawOfSigns(SubExpression)
vToken = GetEvalToken(SubExpression)
tmpPos = InStrB(1, SubExpression, vToken.DefString)
If tmpPos > 2 Then
PrevChar = MidB$(SubExpression, tmpPos - 2, 2)
OperandInBundle = (InStrB(1, op_AllItems, PrevChar))
Do While Not OperandInBundle And tmpPos > 2
tmpPos = InStrB(tmpPos + 2, SubExpression, vToken.DefString)
PrevChar = MidB$(SubExpression, tmpPos - 2, 2)
OperandInBundle = (InStrB(1, op_AllItems, PrevChar))
Loop
End If
SubExpression = MidB$(SubExpression, 1, tmpPos - 1) & _
tmpReplacement & MidB$(SubExpression, tmpPos + LenB(vToken.DefString))
AppendToBuffer outBuffer, vToken
switch = (SubExpression <> tmpReplacement)
If switch Then
OperationIndex = OperationIndex + 1
tmpReplacement = GetSubstStr(OperationIndex)
End If
Loop While switch
End Sub
When these processes finish without any alert, the result obtained is an evaluation tree ready to be processed. It is at this point where the Compute
method comes into play, which is responsible for processing the evaluation tree and returning a result. The process to evaluate is relatively simple code, the difficulty lies in the relationship between results of those evaluation trees related to each other, in which case it is necessary to link previous results with other operations to compute new results.
To make the linking of results possible and feasible, the variable BaseIndex
was devised, which indicates whether an argument is related to a branch of the same evaluation tree and/or to results obtained when evaluating another tree. The Compute
method runs through the evaluation tree of each token, extracting its operands and saving the result after evaluating each one. The result obtained after evaluating arrays (with m rows of n columns) and lists are stored in the format in which they were entered.
Private Function Compute() As String
Dim B As Long
Dim t As Long
Dim i As Long
Dim OperationIndex As Long
Dim BaseIndex As Long
Dim PrevOP1 As String
Dim PrevOP2 As String
BaseIndex = UBound(SubTreeData) + 1
For B = LBound(EvalTree) To UBound(EvalTree)
OperationIndex = BaseIndex
For t = 0 To EvalTree(B).Index
OperationIndex = OperationIndex + 1
If Not EvalTree(B).Storage(t).ConstantToken Then
If P_GALLOPING_MODE Then
PrevOP1 = EvalTree(B).Storage(t).Arg1.Operand
PrevOP2 = EvalTree(B).Storage(t).Arg2.Operand
End If
GetOperands EvalTree(B).Storage(t), EvalTree(B), BaseIndex
BottomLevelEval EvalTree(B).Storage(t)
If P_GALLOPING_MODE Then
EvalTree(B).Storage(t).ConstantToken = _
(PrevOP1 = EvalTree(B).Storage(t).Arg1.Operand And _
PrevOP2 = EvalTree(B).Storage(t).Arg2.Operand)
End If
End If
Next t
If Not EvalTree(B).CompCluster Then
EvalTree(B).EvalResult = EvalTree(B).Storage(t - 1).EvalResult
Else
Dim tmpResult() As String
ReDim tmpResult(0 To EvalTree(B).Index)
For i = 0 To EvalTree(B).Index
tmpResult(i) = EvalTree(B).Storage(i).EvalResult
Next i
If Not EvalTree(B).CompArrCluster Then
EvalTree(B).EvalResult = Join$(tmpResult, P_SEPARATORCHAR)
Else
EvalTree(B).EvalResult = JoinArrFunctArg_
(tmpResult, EvalTree(B).ClusterArrBounds(0), EvalTree(B).ClusterArrBounds(1))
End If
End If
Next B
Compute = EvalTree(B - 1).EvalResult
ComputedTree = True
End Function
The operands are obtained through the GetOperands
and GetOperand
methods.
Private Sub GetOperands(ByRef CurToken As Token, ByRef CurTree As ClusterTree, _
ByRef BaseIndex As Long)
GetOperand CurToken, CurToken.Arg1, CurTree, BaseIndex
If Not CurToken.OperationToken = otNull Then
GetOperand CurToken, CurToken.Arg2, CurTree, BaseIndex
End If
End Sub
Private Sub GetOperand(ByRef CurToken As Token, ByRef CurArg As Argument, _
ByRef CurTree As ClusterTree, ByRef BaseIndex As Long)
If CurArg.Implicit Then
If CurArg.FunctionIn Then
If CurArg.FactorialIn Then
If CurArg.LinkedIndex >= BaseIndex Then
CurArg.Operand = Factorial(EvalFunction_
(CurTree.Storage(CurArg.LinkedIndex - BaseIndex).EvalResult, _
CurArg.FuncName, CurArg.UDFFunctionIn))
Else
CurArg.Operand = Factorial(EvalFunction(EvalTree_
(CurArg.LinkedIndex).EvalResult, _
CurArg.FuncName, CurArg.UDFFunctionIn))
End If
Else
If CurArg.LinkedIndex >= BaseIndex Then
CurArg.Operand = EvalFunction(CurTree.Storage_
(CurArg.LinkedIndex - BaseIndex).EvalResult, _
CurArg.FuncName, CurArg.UDFFunctionIn)
Else
CurArg.Operand = EvalFunction(EvalTree(CurArg.LinkedIndex).EvalResult, _
CurArg.FuncName, CurArg.UDFFunctionIn)
End If
End If
Else
If CurArg.LinkedIndex >= BaseIndex Then
If CurArg.FactorialIn Then
CurArg.Operand = Factorial(CurTree.Storage_
(CurArg.LinkedIndex - BaseIndex).EvalResult)
Else
CurArg.Operand = CurTree.Storage(CurArg.LinkedIndex - BaseIndex).EvalResult
End If
Else
If CurArg.FactorialIn Then
CurArg.Operand = Factorial(EvalTree(CurArg.LinkedIndex).EvalResult)
Else
CurArg.Operand = EvalTree(CurArg.LinkedIndex).EvalResult
End If
End If
End If
If AscW(CurArg.DefString) = 45 Then
CurArg.Operand = ApplyLawOfSigns(op_minus + CurArg.Operand)
End If
Else
If CurArg.LinkedVar > -1 Then
If CurArg.FactorialIn Then
CurArg.Operand = Factorial(ExprVariables.Storage(CurArg.LinkedVar).value)
Else
CurArg.Operand = ExprVariables.Storage(CurArg.LinkedVar).value
End If
If AscW(CurArg.DefString) = 45 Then
CurArg.Operand = ApplyLawOfSigns(op_minus + CurArg.Operand)
End If
Else
If CurArg.FactorialIn Then
CurArg.Operand = Factorial(MidB$(CurArg.DefString, 1, _
LenB(CurArg.DefString) - 2))
Else
CurArg.Operand = CurArg.DefString
End If
End If
End If
End Sub
Finally, each token is evaluated by the BottomLevelEval
method:
Private Sub BottomLevelEval(ByRef aToken As Token)
If aToken.OperationToken < 8 Then
Select Case aToken.OperationToken
Case OperatorToken.otSum
aToken.EvalResult = CastOPtype(aToken.Arg1.Operand, _
aToken.Arg1.NegationFlagOn) _
+ CastOPtype(aToken.Arg2.Operand, _
aToken.Arg2.NegationFlagOn)
Case OperatorToken.otDiff
aToken.EvalResult = CastOPtype(aToken.Arg1.Operand, _
aToken.Arg1.NegationFlagOn) - _
CastOPtype(aToken.Arg2.Operand, _
aToken.Arg2.NegationFlagOn)
Case OperatorToken.otMultiplication
aToken.EvalResult = CastOPtype(aToken.Arg1.Operand, _
aToken.Arg1.NegationFlagOn) * _
CastOPtype(aToken.Arg2.Operand, _
aToken.Arg2.NegationFlagOn)
Case OperatorToken.otDivision
aToken.EvalResult = CastOPtype(aToken.Arg1.Operand, _
aToken.Arg1.NegationFlagOn) / _
CastOPtype(aToken.Arg2.Operand, _
aToken.Arg2.NegationFlagOn)
Case OperatorToken.otPower
Dim kFctr As Double
If AscW(aToken.Arg1.DefString) = 45 Then
kFctr = -1
Else
kFctr = 1
End If
aToken.EvalResult = kFctr * CastOPtype(aToken.Arg1.Operand, _
aToken.Arg1.NegationFlagOn) ^ _
CastOPtype(aToken.Arg2.Operand, _
aToken.Arg2.NegationFlagOn)
Case OperatorToken.otMod
aToken.EvalResult = CastOPtype(aToken.Arg1.Operand, _
aToken.Arg1.NegationFlagOn) Mod _
CastOPtype(aToken.Arg2.Operand, _
aToken.Arg2.NegationFlagOn)
Case OperatorToken.otIntDiv
aToken.EvalResult = Floor(CastOPtype(aToken.Arg1.Operand, _
aToken.Arg1.NegationFlagOn) / _
CastOPtype(aToken.Arg2.Operand, _
aToken.Arg2.NegationFlagOn))
Case Else
If aToken.Logical Then
If aToken.Arg1.NegationFlagOn Then
If AscW(aToken.Arg1.Operand) <> 126 Then
aToken.EvalResult = Not CBool(aToken.Arg1.Operand)
Else
aToken.EvalResult = _
Not CBool(MidB$(aToken.Arg1.Operand, 3))
End If
Else
aToken.EvalResult = CBool(aToken.Arg1.Operand)
End If
Else
aToken.EvalResult = aToken.Arg1.Operand
End If
End Select
Else
If aToken.OperationToken < 14 Then
Select Case aToken.OperationToken
Case OperatorToken.otEqual
aToken.EvalResult = (CastOPtype(aToken.Arg1.Operand, _
aToken.Arg1.NegationFlagOn) = _
CastOPtype(aToken.Arg2.Operand, _
aToken.Arg2.NegationFlagOn))
Case OperatorToken.otNotEqual
aToken.EvalResult = (CastOPtype(aToken.Arg1.Operand, _
aToken.Arg1.NegationFlagOn) <> _
CastOPtype(aToken.Arg2.Operand, _
aToken.Arg2.NegationFlagOn))
Case OperatorToken.otGreaterThan
aToken.EvalResult = CastOPtype(aToken.Arg1.Operand, _
aToken.Arg1.NegationFlagOn) > _
CastOPtype(aToken.Arg2.Operand, _
aToken.Arg2.NegationFlagOn)
Case OperatorToken.otLessThan
aToken.EvalResult = CastOPtype(aToken.Arg1.Operand, _
aToken.Arg1.NegationFlagOn) < _
CastOPtype(aToken.Arg2.Operand, _
aToken.Arg2.NegationFlagOn)
Case OperatorToken.otGreaterThanOrEqual
aToken.EvalResult = CastOPtype(aToken.Arg1.Operand, _
aToken.Arg1.NegationFlagOn) >= _
CastOPtype(aToken.Arg2.Operand, _
aToken.Arg2.NegationFlagOn)
Case Else
aToken.EvalResult = CastOPtype(aToken.Arg1.Operand, _
aToken.Arg1.NegationFlagOn) <= _
CastOPtype(aToken.Arg2.Operand, _
aToken.Arg2.NegationFlagOn)
End Select
Else
Dim tmpBooleans() As Boolean
Select Case aToken.OperationToken
Case OperatorToken.otLogicalAND
tmpBooleans() = GetLogicalNeg(aToken)
aToken.EvalResult = tmpBooleans(0) And tmpBooleans(1)
Case OperatorToken.otLogicalOR
tmpBooleans() = GetLogicalNeg(aToken)
aToken.EvalResult = tmpBooleans(0) Or tmpBooleans(1)
Case Else
tmpBooleans() = GetLogicalNeg(aToken)
aToken.EvalResult = tmpBooleans(0) Xor tmpBooleans(1)
End Select
End If
End If
End Sub
The EvalFunction
method is in charge of evaluating the functions included in the parsed expression, as mentioned before, the user-defined functions (UDF) will receive an array of text strings, but given the requirements of the CallByName
function the only argument that the UDFs must exhibit must be of variant type.
Private Function EvalFunction(ByRef Argument As String, _
ByRef FunctionName As String, Optional IsUDF As Boolean = False) As String
If Not IsUDF Then
Select Case FunctionName
Case "Absolute"
EvalFunction = Absolute(Argument)
Case "ArcSin"
EvalFunction = ArcSin(Argument)
Case "ArcCos"
EvalFunction = ArcCos(Argument)
Case "ArcTan"
EvalFunction = ArcTan(Argument)
Case "Average"
EvalFunction = average(Argument)
Case "Cosin"
EvalFunction = Cosin(Argument)
Case "aCeiling"
EvalFunction = aCeiling(Argument)
Case "ExpEuler"
EvalFunction = ExpEuler(Argument)
Case "aFloor"
EvalFunction = aFloor(Argument)
Case "Gamma"
EvalFunction = tGamma(Argument)
Case "Logarithm"
EvalFunction = Logarithm(Argument)
Case "LgN"
EvalFunction = LgN(Argument)
Case "LN"
EvalFunction = LN(Argument)
Case "Max"
EvalFunction = Max(Argument)
Case "Min"
EvalFunction = Min(Argument)
Case "Percent"
EvalFunction = Percent(Argument)
Case "Power"
EvalFunction = Power(Argument)
Case "Sign"
EvalFunction = Sign(Argument)
Case "Sine"
EvalFunction = Sine(Argument)
Case "SquareRoot"
EvalFunction = SquareRoot(Argument)
Case "Tangent"
EvalFunction = Tangent(Argument)
Case Else
End Select
Else
EvalFunction = EvalUDF(FunctionName, Argument)
End If
End Function
Private Function EvalUDF(ByRef UDFname As String, ByRef Expression As String) As String
Dim args As Variant
Dim tmpEval As String
Dim UDFidx As Long
UDFidx = GetCBItemIdx(UserDefFunctions, UDFname)
If UDFidx > -1 Then
args = SplitArgs(Expression)
tmpEval = CallByName(callback(UserDefFunctions.Storage(UDFidx).value), _
UDFname, VbMethod, args)
EvalUDF = tmpEval
End If
End Function
Using the Code
Let's start with the evaluation of an expression with multiple parentheses:
Sub SimpleMathEval()
Dim Evaluator As VBAexpressions
Set Evaluator = New VBAexpressions
With Evaluator
.Create "(((((((((((-123.456-654.321)*1.1)*2.2)*3.3)+4.4)+5.5)+_
6.6)*7.7)*8.8)+9.9)+10.10)"
If .ReadyToEval Then
.Eval
End If
End With
End Sub
Now let's see how to evaluate an expression that contains variables whose values are defined at the moment the evaluation of the expression is requested.
Sub LateVariableAssignment()
Dim Evaluator As VBAexpressions
Set Evaluator = New VBAexpressions
With Evaluator
.Create "Pi.e * 5.2Pie.1 + 3.1Pie"
If .ReadyToEval Then
Debug.Print "Variables: "; .CurrentVariables
.Eval ("Pi.e=1; Pie.1=2; Pie=3")
Debug.Print .Expression; " = "; .Result; _
"; for: "; .CurrentVarValues
End If
End With
End Sub
The values of the variables can also be defined prior to calling the Eval
method.
Sub EarlyVariableAssignment()
Dim Evaluator As VBAexpressions
Set Evaluator = New VBAexpressions
With Evaluator
.Create "Pi.e * 5.2Pie.1 + 3.1Pie"
If .ReadyToEval Then
Debug.Print "Variables: "; .CurrentVariables
.VarValue("Pi.e") = 1
.VarValue("Pie.1") = 2
.VarValue("Pie") = 3
.Eval
Debug.Print .Expression; " = "; .Result; _
"; for: "; .CurrentVarValues
End If
End With
End Sub
The trigonometric functions included in the library can be evaluated using radians or degrees.
Sub TrigFunctions()
Dim Evaluator As VBAexpressions
Set Evaluator = New VBAexpressions
With Evaluator
.Create "asin(sin(30))"
If .ReadyToEval Then
.Degrees = True
.Eval
End If
End With
End Sub
An important feature of VBA Expressions is that the user can use the GallopingMode
property to avoid reevaluating those tokens whose value remains constant between calls to the Eval
method.
Points of Interest
This method has proven to be quite flexible, since it follows the same mental process we use when evaluating expressions on paper, allowing, with the use of parentheses, some very powerful hacks. This virtue was exploited when it came to admitting arrays and lists.
Although corner cases have been selected that have caused other solutions to fail, much more testing is needed to ensure that the tool contains a negligible amount of programming errors. Feel free to suggest expressions that can be used in the tests.
History
- 25th February, 2022: First release