Excel VBA: Evaluate met een cel waarin een UDF staat

[bveyndhoven]

Hey mensen,

Ik heb een tamelijk gecompliceerde vraag:

Ik heb in VBA een module "UDF's" waarin ik zelfgemaakte functies heb gedefinieerd. Deze formules kan ik in cellen gebruiken zoals ik bv. de formule SUM gebruik. De inhoud ervan is deze:

Function Eval(r As Range) As Variant
    Eval = Evaluate(r.Value)
End Function

Function Sigma(nformula As String, nvariable As String, nbegin As Integer, nend As Integer) As Variant

    Dim result As Variant
    Dim i As Integer
    Dim minValue As Integer
    Dim maxValue As Integer
        
    result = 0
    
    If nbegin > nend Then
        minValue = nend
        maxValue = nbegin
    Else
        minValue = nbegin
        maxValue = nend
    End If
        
    For i = minValue To maxValue
       result = result + Evaluate(Replace(nformula, nvariable, i))
    Next
    
    Sigma = result

End Function

De functie Eval zet een tekstwaarde in een cel om en interpreteert deze als formule. Dus stel dat ik in A1 de waarde SUM(B1:B3) heb staan en in A2 de formule =Eval(A1), zal in A2 de som van het bereik B1 tot B3 komen.

De formule Sigma voert de wiskundige Sigma-bewerking uit. Bv. De formule =Sigma("2*x";"x";1;5) zal de formule "x*2" uitvoeren voor x = 1, 2, ..., 5 en de resultaten optellen, dus 2+4+6+8+10 = 30.

De Eval-formule werkt goed behalve voor dit ding:
Cel A1 bevat deze waarde: Sigma("x";"x";1;5). Cel A2 bevat =Eval(A1). Ik krijg de melding #VALUE!" terug.

Kan ik deze formule toch laten evalueren?

[edit]Via een andere thread ben ik al te weten gekomen dat een named formule iets flexibeler werkt. Het probleem met m'n Sigma-formule blijft, maar ik vermoed dat het iets te maken heeft met de dubbele aanhalingstekens in de parameters..."[/edit]

Alvast bedankt!

 

[Wigi]

Volgens mij kan je Evaluate wel gebruiken in een UDF, maar als je die UDF aanroept via een andere Evaluate: dan werkt het niet.
Wordt de functie gewoon aangeroepen (zoals: ? Sigma("x", "x", 1, 5)) in het Immediate Window bijvoorbeeld) dan werkt de Evaluate in de UDF wel.
Pas ook op met het tweemaal berekenen van (dezelfde) UDF. Zet maar eens Debug.Print statements tussen de code lijnen.

 

[bveyndhoven]

Als ik je goed begrijp, kan je dus geen UDF's nesten in een cel (dus een cel die een UDF binnen een UDF gebruikt.

Goed om weten. Dan zal ik mijn aanpak wat moeten herzien .

Alleszins bedankt voor je antwoord. Bij deze gaat ook deze thread op Solved

 

[Wigi]

Uit hetgeen ik gisterenavond uitgezocht heb, blijkt volgens mij dat je geen Evaluate binnen een Evaluate kan hebben.

Je kan wel een UDF hebben die een Evaluate doet, maar de Evaluate en de Replace is hetgeen niet werkt.

Ik heb jouw UDF Sigma heel fel versimpeld, en zelfs die werkte al niet. Terwijl een gewone aanroep met bijvoorbeeld een MsgBox wel werkt (met een Evaluate in de Sigma functie).

 

[WHER]

Even terzijde, los van het Evaluate-aspect: de werking van de UDF Sigma lijkt heel sterk op die van Sumproduct, zie bijlage.

 

[bveyndhoven]

Even terzijde, los van het Evaluate-aspect: de werking van de UDF Sigma lijkt heel sterk op die van Sumproduct, zie bijlage.

Klopt, enkel met het verschil dat je niet enkel kan werken met getallen van 1 tot 65536 maar ook negatieve getallen en getallen voorbij 65536. Met SumProduct is dit niet mogelijk.

 

[Wigi]

Klopt, enkel met het verschil dat je niet enkel kan werken met getallen van 1 tot 65536 maar ook negatieve getallen en getallen voorbij 65536. Met SumProduct is dit niet mogelijk.

Daarnaast vermoed ik dat de bedoeling van de Evaluate aanpak is om het functievoorschrift (x of 2*x) makkelijk aan te passen en het effect te zien.
Zonder de SOMPRODUCT aan te passen.

 

[bveyndhoven]

Ook al... De formule die wordt verwerkt kan variëren en moet dus makkelijk kunnen worden meegegeven. Da's de reden waarom ik die UDF heb gemaakt. Is best leuk, maar geen default function dus met evaluaties kan je vast zitten. Eigenlijk best jammer...

 

[Wigi]

Ik heb het kunnen oplossen met jouw functie.

In de cel:

Sigma("2*x","x",1,5)

( dus , ipv ; op mijn Engelstalige Excel versie, waarschijnlijk blijft dit ; voor jou)

Vervolgens creëer ik een nieuwe Excel instantie (tijdelijk) in de functie en gebruik ik van die instantie de Evaluate methode:

Function Sigma(nformula As String, nvariable As String, nbegin As Integer, nend As Integer) As Variant

    Dim result As Variant
    Dim i As Integer
    Dim minValue As Integer
    Dim maxValue As Integer

    result = 0

    If nbegin > nend Then
        minValue = nend
        maxValue = nbegin
    Else
        minValue = nbegin
        maxValue = nend
    End If

[B][COLOR="red"]    Dim xlApp As Excel.Application
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False[/COLOR][/B]

    For i = minValue To maxValue
        result = result + [B][COLOR="red"]xlApp.[/COLOR]Evaluate(Replace(nformula, nvariable, i))[/B]
    Next

[B][COLOR="red"]    xlApp.Quit
    Set xlApp = Nothing[/COLOR][/B]

    Sigma = result

End Function

Nodeloos te zeggen, dit is duidelijk trager in mijn tests, maar werken doet het wel

 

[Wigi]

Of iets korter:

Function Sigma(nformula As String, nvariable As String, nbegin As Integer, nend As Integer) As Variant

    Dim result As Variant
    Dim i As Integer
    Dim minValue As Integer
    Dim maxValue As Integer

    result = 0

    If nbegin > nend Then
        minValue = nend
        maxValue = nbegin
    Else
        minValue = nbegin
        maxValue = nend
    End If

    With CreateObject("Excel.Application")

        For i = minValue To maxValue
            result = result + .Evaluate(Replace(nformula, nvariable, i))
        Next

    End With

    Sigma = result

End Function

Overigens, als je toch VBA gebruikt, waarom niet een Worksheet_Change event gebruiken op de cel met de Sigma(...) in.
Vervolgens geen Eval meer, maar wel het Worksheet_Change event die de Sigma berekent in alle cellen waar dat nodig is.

Lijkt mij een veel betere (en snellere) oplossing te zijn.

 

[Mark xl]

En als je probeert de Eval functie om te bouwen door sigma apart door te sturen naar een andere functie die de verwerking van "sigma" voor zijn rekening neemt?

Ik heb geprobeerd een alternatieve route te maken inde functgie EVal voor het geval de functie "eval" de functie "sigma" aanroept
Ik heb ook kleinschalig getest met eventuele subexpressies en dat ging redelijk, bijvoorbeeld "sigma("x * 2";"x";sum(A1:A4);sum(1,2,2))" evalueert goed.

geen idee van de performance impact op grote schaal.
misschien kun je hier wat mee. het lijkt me altijd nuttig om alternatieven te bestuderen

de constante "FUNC_SEP" staat in excel nederlands op ";". was dat in de engelse versie geen komma ofzo? zo ja, moet je dat even aanpassen. (wordt nog een leuke als je in conflict komt met thousand separators, wat volgens mij in het engels ook een komma is, maar daar had je natuurlijk in de oorspronkelijke versie ook al last van).

[Wall of code incoming]

Option Explicit

'if these settings differ for your system, feel free to amend it
Private Const PAR_CLOSE As String = ")"
Private Const PAR_OPEN As String = "("
Private Const FUNC_SEP As String = ";"      'dont know if this differs per implementation ?

Public Function Eval(r As Range) As Variant
Dim expr As String
    
    expr = r.Value
    If InStr(1, expr, "sigma(", vbTextCompare) Then
        Eval = EvalSigma(LCase(expr))   'lower case
    Else
        Eval = Evaluate(expr)
    End If

End Function

Public Function Sigma(nformula As String, nvariable As String, nbegin As Integer, nend As Integer) As Long

    Dim result As Variant
    Dim i As Integer
    Dim minValue As Integer
    Dim maxValue As Integer
        
    result = 0
    
    If nbegin > nend Then
        minValue = nend
        maxValue = nbegin
    Else
        minValue = nbegin
        maxValue = nend
    End If
        
    For i = minValue To maxValue
       result = result + Evaluate(Replace(nformula, nvariable, i))
    Next
    
    Sigma = result

End Function

Private Function EvalSigma(expr As String) As Variant
'attempt to evaluate the sigma formula subexpressions are allowed
'note: this has not been extensively tested

Dim args(4) As Variant      'array for expressions to be evaluated
Dim pos(4) As Long          'array of positions of expressions
Dim exprList() As String    'list of expressions
Dim sigmaExpr As String     'catch subexpression from exprList
Dim i As Long               'expression counter
Dim result As Long          'resulting variable
Dim lastchar As Long        'last parenthesis

    exprList = Split(expr, "sigma(")
    lastchar = FindClosingParentesis(expr, 1)
    
    For i = 1 To UBound(exprList)   '0 is skipped
    
        sigmaExpr = exprList(i)
        
        pos(0) = FindNextSeparator(sigmaExpr, 1)            'first argument
        pos(1) = FindNextSeparator(sigmaExpr, pos(0) + 1)   'second argument
        pos(2) = FindNextSeparator(sigmaExpr, pos(1) + 1)   'third argument
        pos(3) = FindClosingParentesis(sigmaExpr, 1)        'fourth argument
        
        args(0) = Evaluate(Mid(sigmaExpr, 1, pos(0) - 1))                       'evaluate subexpression 1
        args(1) = Evaluate(Mid(sigmaExpr, pos(0) + 1, pos(1) - (pos(0) + 1)))   'evaluate subexpression 2
        args(2) = Evaluate(Mid(sigmaExpr, pos(1) + 1, pos(2) - (pos(1) + 1)))   'evaluate subexpression 3
        args(3) = Evaluate(Mid(sigmaExpr, pos(2) + 1, pos(3) - (pos(2) + 1)))   'evaluate subexpression 4
    
        result = result + Sigma(Replace(CStr(args(0)), """", ""), _
                                Replace(CStr(args(1)), """", ""), _
                                CLng(args(2)), _
                                CLng(args(3)))
        
        're-initialize the arrays with "zero":
        Erase args
        Erase pos
    
    Next
    
    EvalSigma = result
    
End Function

Private Function FindClosingParentesis(ByVal expr As String, _
                                       Optional startvalue As Long = 1) As Long
    Dim opencnt As Long
    Dim closecnt As Long
    Dim cnt As Long
    opencnt = startvalue

    Do While opencnt <> closecnt And cnt < Len(expr)
        
        cnt = cnt + 1
        opencnt = opencnt + Abs(Mid(expr, cnt, 1) = PAR_OPEN)
        closecnt = closecnt + Abs(Mid(expr, cnt, 1) = PAR_CLOSE)
        
    Loop

    FindClosingParentesis = cnt

End Function

Private Function FindNextSeparator(ByVal expr As String, _
                                   Optional startpos As String = 1) As Long
    Dim opencnt As Long
    Dim closecnt As Long
    Dim cnt As Long
    Dim char() As Byte  'array with characters of expr
    
    char = StrConv(expr, vbFromUnicode) 'omzetten naar array van chars
    cnt = startpos - 1
    
    'loop while max length has not been met,
    'and the current expression has a separator while at the root level
    Do While cnt <= Len(expr) And Not _
             (char(cnt) = Asc(FUNC_SEP) And opencnt = closecnt)
        opencnt = opencnt + Abs(char(cnt) = Asc(PAR_OPEN))
        closecnt = closecnt + Abs(char(cnt) = Asc(PAR_CLOSE))
        cnt = cnt + 1
    Loop
    
    FindNextSeparator = cnt + 1

End Function

 

[Wigi]

Dit werkt inderdaad Mark.

Dit lijkt me een goede workaround, rekening houdend met de extra functies die geschreven moeten worden.
In de eerste plaats EvalSigma, aangezien die "gedupliceerd" zal moeten worden voor andere functies (gamma, delta, ... )

 

[Mark xl]

ik wist nog niets van andere functies

dan wordt het wijzer om wat klassen te bedenken.

sowieso nog even goed over de huidige aanpak nadenken kan geen kwaad.
aangezien de functie "sigma" niet Volatile is, kan misschien een Knop "berekenen" ook een uitkomst zijn, waarbij je het berekenen in VBA uitvoert, en vervolgens de uitkomsten de cellen laat plaatsen.

Ik krijg slechts met "F2+Return" op een cel een formule berekend nu

De huidige versie van Sigma kan trouwens op deze manier geformuleerd worden:
(gebruik Abs() om groter..dan/kleiner..dan af te vangen)

Public Function Sigma(nformula As String, nvariable As String, nbegin As Long, nend As Long) As Variant

    Dim result As Variant
    Dim i As Long
            
    For i = 1 To Abs(nbegin - nend)
       result = result + Evaluate(Replace(nformula, nvariable, i))
    Next

    Sigma = result

End Function

Gefeliciteerd met je MVP status trouwens! (geen idee hoe lang dat al zo is)

 

[bveyndhoven]

Hey mensen,

Heel erg bedankt voor de info. Ik denk dat ik er een pak wijzer uit zal worden.

Jammer genoeg heb ik de eerste paar dagen nog geen tijd om het volledig te testen, maar ergens begin komende week ga ik dat zeker even doen en dan geef ik een seintje of het me gelukt is. En als het lukt: problem solved!

Tussen twee haakjes: het toeval wil dat ik ook met een Engelstalige Windows/Excel werk

e constante "FUNC_SEP" staat in excel nederlands op ";". was dat in de engelse versie geen komma ofzo? zo ja, moet je dat even aanpassen. (wordt nog een leuke als je in conflict komt met thousand separators, wat volgens mij in het engels ook een komma is, maar daar had je natuurlijk in de oorspronkelijke versie ook al last van).

Die Thousand-seperators worden geregeld via de Regional settings in Windows. Om verwarring te voorkomen laat ik de argument seperator liever op ; staan

Het performance-aspect zal trouwens al bij al nog meevallen. Het zal niet over honderden cellen gaan, maar het doel is dus als volgt:

Afnankelijk van een aantal criteria wordt de functiedefinitie samengesteld als tekstwaarde. Jammer genoeg zijn het wat teveel criteria om met de IF-functie op te vangen, en daarom dus deze werkwijze. De Sigma dient vooral om de handel wat overzichtelijker te houden (maar ook omdat die af en toe gebruikt zal moeten over een negatief bereik, bv. van -12 tot -3).

Wordt ongetwijfeld zeer binnenkort vervolgd