请各位高手帮助改一段代码（以适应自治函数的套嵌计算，谢谢！！！）

Question

代码为字符串计算的(aaa只计算了一次3*6，sin能计算两次（或多次）)请大家帮助看看能不能修改成aaa也能几次套嵌计算的，谢谢!!! 红色字部分是我自己试者加的text1="4*aaa(aaa(3,6),7)+sin(sin(4))"Private Function EvaluateExpr(ByVal expr As String) As Single
  '--------------------------------------------------------------------------
  '¹¦ÄÜ:
  '               ×Ö·û´®±í´ïʽµÄ¼ÆËã
  '²ÎÊý:
  '               [expr]...........................×Ö·û´®±í´ïʽ
  '·µ»ØÖµ:
  '               [EvaluateExpr]...................¼ÆËãºóµÄÖµ
  '--------------------------------------------------------------------------
  Const PREC_NONE = 11
  Const PREC_UNARY = 10             '   Not   actually   used.
  Const PREC_POWER = 9
  Const PREC_TIMES = 8
  Const PREC_DIV = 7
  Const PREC_INT_DIV = 6
  Const PREC_MOD = 5
  Const PREC_PLUS = 4
  Dim v As Variant
  Dim is_unary     As Boolean
  Dim next_unary     As Boolean
  Dim parens     As Integer
  Dim pos     As Integer
  Dim expr_len     As Integer
  Dim ch     As String
  Dim lexpr     As String
  Dim rexpr     As String
  Dim Value     As String
  Dim status     As Long
  Dim best_pos     As Integer
  Dim best_prec     As Integer
  Dim temp As Integer
    
          '   É¾³ýÊ×β¿Õ¸ñ¼°ÓÐЧÐÔУÑé
          expr = Trim$(expr)
          expr_len = Len(expr)
          If expr_len = 0 Then Exit Function
          is_unary = True
            
          best_prec = PREC_NONE
   
          For pos = 1 To expr_len
                  '   Examine   the   next   character.(¼ì²éÏÂÒ»¸ö×Ö·û)
                  ch = Mid$(expr, pos, 1)
 
                  next_unary = False
                    
                  If ch = "   " Then
                          next_unary = is_unary
                  ElseIf ch = "(" Then
                          parens = parens + 1
    
                          next_unary = True
                  ElseIf ch = ")" Then
                          parens = parens - 1
    
                          '   An   operator   after   ")"   is   not   unary.
                          next_unary = False
    
                          '   If   parens   <   0,   too   many   ')'s.
                          If parens < 0 Then
                                  Err.Raise vbObjectError + 1001, _
                                          "EvaluateExpr", _
                                          "Too   many   )s   in   '" & _
                                          expr & "'"
                          End If
                  ElseIf parens = 0 Then
                          '   See   if   this   is   an   operator.
                          If ch = "^" Or ch = "*" Or _
                                ch = "/" Or ch = "\" Or _
                                ch = "%" Or ch = "+" Or _
                                ch = "-" _
                          Then
                                  '   An   operator   after   an   operator
                                  '   is   unary.
                                  next_unary = True
                                    
                                  Select Case ch
                                          Case "^"
                                                  If best_prec >= PREC_POWER Then
                                                          best_prec = PREC_POWER
                                                          best_pos = pos
                                                  End If
                                          Case "*", "/"
                                                  If best_prec >= PREC_TIMES Then
                                                          best_prec = PREC_TIMES
                                                          best_pos = pos
                                                  End If
                                            
                                          Case "\"
                                                  If best_prec >= PREC_INT_DIV Then
                                                          best_prec = PREC_INT_DIV
                                                          best_pos = pos
                                                  End If
                                            
                                          Case "%"
                                                  If best_prec >= PREC_MOD Then
                                                          best_prec = PREC_MOD
                                                          best_pos = pos
                                                  End If
                                            
 

Answer 1

                                         Case "+", "-"
                                                  '   Ignore   unary   operators
                                                  '   for   now.
                                                  If (Not is_unary) And _
                                                          best_prec >= PREC_PLUS _
                                                  Then
                                                          best_prec = PREC_PLUS
                                                          best_pos = pos
                                                  End If
                                  End Select
                          End If
                  End If
                  is_unary = next_unary
          Next pos
      
          '   If   the   parentheses   count   is   not   zero,
          '   there's   a   ')'   missing.
          If parens <> 0 Then
                  Err.Raise vbObjectError + 1002, _
                          "EvaluateExpr", "Missing   )   in   '" & _
                          expr & "'"
          End If
            
          '   Hopefully   we   have   the   operator.
          '   best_precÊÇ×î¸ßµÄÔËËã·û
          Dim dblTemp1     As Double, dblTemp2       As Double
          If best_prec < PREC_NONE Then
                  lexpr = Left$(expr, best_pos - 1)
                  rexpr = Right$(expr, expr_len - best_pos)
                  Select Case Mid$(expr, best_pos, 1)
                          Case "^"
                                  EvaluateExpr = EvaluateExpr(lexpr) ^ EvaluateExpr(rexpr)
                          Case "*"
                                  EvaluateExpr = EvaluateExpr(lexpr) * EvaluateExpr(rexpr)
                          Case "/"
                                  dblTemp1 = EvaluateExpr(rexpr)
                                  dblTemp2 = EvaluateExpr(lexpr)
                                  If dblTemp1 = 0 Then
                                          EvaluateExpr = 0
                                  Else
                                          EvaluateExpr = dblTemp2 / dblTemp1
                                  End If
                          Case "\"
                                  EvaluateExpr = EvaluateExpr(lexpr) \ EvaluateExpr(rexpr)
                          Case "%"
                                  EvaluateExpr = EvaluateExpr(lexpr) Mod EvaluateExpr(rexpr)
                          Case "+"
                                  EvaluateExpr = EvaluateExpr(lexpr) + EvaluateExpr(rexpr)
                          Case "-"
                                  EvaluateExpr = EvaluateExpr(lexpr) - EvaluateExpr(rexpr)
                  End Select
                  Exit Function
          End If
            
          If Left$(expr, 1) = "(" And Right$(expr, 1) = ")" Then
                  '   Remove   the   parentheses.
                  EvaluateExpr = EvaluateExpr(Mid$(expr, 2, expr_len - 2))
                  Exit Function
          End If
                    
          '   Look   for   -expr2.
          If Left$(expr, 1) = "-" Then
                  EvaluateExpr = -EvaluateExpr( _
                          Right$(expr, expr_len - 1))
                  Exit Function
          End If
            
          '   Look   for   +expr2.
          If Left$(expr, 1) = "+" Then
                  EvaluateExpr = EvaluateExpr( _
                          Right$(expr, expr_len - 1))
                  Exit Function
          End If
            
          '   Look   for   Fun(expr2).
          If expr_len > 5 And Right$(expr, 1) = ")" Then
                  lexpr = LCase$(Left$(expr, 4))
                  rexpr = Mid$(expr, 5, expr_len - 5)
               
                  
                  Select Case lexpr
                  
                          Case "sin("
                          MsgBox rexpr
                                  
                                  EvaluateExpr = Sin(EvaluateExpr(rexpr))
                                
                                  Exit Function
                          Case "cos("
                                  EvaluateExpr = Cos(EvaluateExpr(rexpr))
                                  Exit Function
                          Case "tan("
                                  EvaluateExpr = Tan(EvaluateExpr(rexpr))
                                  Exit Function
                          Case "sqr("
                                  EvaluateExpr = Sqr(EvaluateExpr(rexpr))
                                  Exit Function
                          Case "aaa("
                                 
                          v = Split(expr, ",")
                          For i = 1 To UBound(v)
                          If i = 1 Then
                          temp = Val(Mid(rexpr, 7, 1))
                          rexpr = Mid(rexpr, 5, 1)
                      '    EvaluateExpr = aaa(EvaluateExpr(rexpr), temp)
                          End If
                          Next
                          If i = 2 Then
                          temp = Val(Mid(rexpr, 7, 1))
                          rexpr = Mid(rexpr, 5, 1)
                          EvaluateExpr = aaa(EvaluateExpr(rexpr), temp)
                          End If
                     '     EvaluateExpr = aaa(EvaluateExpr(rexpr), temp)
                          Exit Function                  End Select
          End If
           
          '   See   if   it's   a   primitive.
          On Error Resume Next
         
            Value = Primitives.Item(expr)
          
          
          status = Err.Number
          On Error GoTo 0
          If status = 0 Then
                  EvaluateExpr = CSng(Value)
                  Exit Function
          End If
          
          '   It   must   be   a   literal   like   "2.71828".
          On Error Resume Next
          EvaluateExpr = CSng(expr)
          status = Err.Number
          On Error GoTo 0
          If status <> 0 Then
                  Err.Raise status, _
                          "EvaluateExpr", _
                          "Error   evaluating   '" & expr & _
                          "'   as   a   constant."
          End If
  End FunctionPrivate Sub Command1_Click()
Text2 = EvaluateExpr(Text1)
End Sub
Public Function aaa(X As Integer, B As Integer) As Integer
aaa = X * BEnd Function

Answer 2

拆分参数时，只有不被括号包含的逗号才是本层函数的参数分隔符。
Function SplitParams(ByVal Expr As String) As String()
    Dim a() As String
    Dim lCount As Long
    Dim ch As String
    Dim lParanCount As Long
    Dim iStart As Long
    Dim i As Long
    
    iStart = 1
    For i = 1 To Len(Expr)
        ch = Mid$(Expr, i, 1)
        Select Case ch
            Case "("
                lParanCount = lParanCount + 1
            Case ")"
                lParanCount = lParanCount - 1
            Case ","
                If lParanCount = 0 Then
                    lCount = lCount + 1
                    ReDim Preserve a(lCount - 1)
                    a(lCount - 1) = Mid$(Expr, iStart, i - iStart)
                    iStart = i + 1
                End If
        End Select
    Next
    If i > iStart Then
        lCount = lCount + 1
        ReDim Preserve a(lCount - 1)
        a(lCount - 1) = Mid$(Expr, iStart, i - iStart)
        iStart = i + 1
    End If
    
    SplitParams = a
End Function
Case "aaa("
    v = SplitParams(rexpr)
    EvaluateExpr = aaa(EvaluateExpr(v(0)), EvaluateExpr(v(1)))
    Exit Function

Answer 3

 to Tiger_Zhao:
谢谢您，我消化一下，如不行，还请您帮助，谢谢！！！

Answer 4

谢谢！！！再求教以下：
text1="4*aaa(aaa(2,3),sin(4))-720" =-744（和我拆分开算不一样）
aaa(2,3)=6
aaa(6,sin(4))=-4.540814971847574*(-4.54081497184757)=-18.1632598873903
-18.1632598873903-720<>-744
请帮助再看看那里有问题，谢谢！！！

Answer 5

函数 aaa() 的参数是 Integer，小数自动取整了！

Answer 6

按照函数来的话  aaa(6,sin(4)) = -6
-4.54081497184757是lz自己手算的吧

Answer 7

谢谢各位高手：sin(4))是因为系统自动默认为弧度.
sin(4)=0.0697564是因为计算其在角度上
谢谢！！！在求教一个问题：在嵌套时text1="4*aaa(aaa(2,3),sin(4))-720" 改称text1="4*aaa(aaa(N,3),sin(4))-720"N我想另外赋值N=2(或其他数)
能该如何做，谢谢！！！

Answer 8

Value = Primitives.Item(expr)
如果没猜错的话，Primitives 就是一个变量的集合，预先加入
Primitives.Add 2, "N"
就能参与表达式运算了。

Answer 9

谢谢！！！
TO Tiger_Zhao:text1="4*aaa(aaa(3,6),7)+sin(sin(4))" TEXT2="4*aaa(TEXT1,7)+sin(sin(4))" 
我想还用上面的代码计算"4*aaa(TEXT1,7)+sin(sin(4))" ，能行吗，谢谢！！！

Answer 10

一样，将 TEXT1 看成变量
Primitives.Add Val(Text1), "TEXT1"

Answer 11

还是不明白：还请你看一下：(由于在新贴里，我表达不清`在这向您求教，分我重新开贴给您，谢谢！！！)
Text1=
"FF: AAA(N,5)-AAA(N,7)" & VBCRLF _   
"DD: AAA(FF,5)" & VBCRLF _ 
"kk: 2*(FF+DD)"
其中的":"前面的FF、DD、KK为任意取得，可为任何字母,后面的FF、DD随前面而定
如：
"FFS: AAA(N,5)-AAA(N,7)" & VBCRLF _   
"DDA: AAA(FFS,5)" & VBCRLF _ 
"kk: 2*(FFS+DDA)"
我用前面根你们学得做了：
Private Type HXCS
    VarName As String
    VarArr(13) As Single
End Type
Private HXTSJ2() As HXCS
我把TEXT1分割成三句
FF: AAA(N,5)-AAA(N,7)和DD: AAA(FF,5)及kk: 2*(FF+DD)三句
然后有取得 HXTSJ2(0).VarName=FF 、HXTSJ2(1).VarName=DD、HXTSJ2(2).VarName=KK
对第一句执行：
FOR I= 1 TO 13
HXTSJ2(0).VarArr(I)=EvaluateExpr("AAA(N,5)-AAA(N,7)") 'N为变量，我已能赋值
NEXT
问题在这：执行第2句
FOR I= 1 TO 13
HXTSJ2(0).VarArr(I)=EvaluateExpr("AAA(FF,5)")'FF的取值为HXTSJ2(0).VarArr(I)，我该如何做
NEXT
我知道执行到下面：(当V(0)=FF)就出错了
Case "aaa("
    v = SplitParams(rexpr)
    SELECT CASE V(0)
    CASE "N"
    V(0)=3
    CASE "FF"
    "FF" 为不确定值,该如何设置这个变量，谢谢！！！
     END SELECT
    EvaluateExpr = aaa(EvaluateExpr(v(0)), EvaluateExpr(v(1)))
    Exit Function

Answer 12

Primitives.Add Val(Text1), "TEXT1"我该加在那里，谢谢！！！

Answer 13

看得不是很明白。
首先，aaa() 函数运算就按照我2楼给的代码，不要对参数作分析，直接递归调用 EvaluateExpr() 即可。
其次，既然 Text1 不是简单表达式就不能直接加到 Primitives 中。
最后，如果 FF: AAA(N,5)-AAA(N,7) 表示右边的运算结果赋值给 FF 的话，那么就将右边表达式的运算结果马上用 FF 作为变量名称加到 Primitives 中，这样后面的表达式运算就能使用变量 FF 了。

Answer 14

谢谢你：
变量名称加到 Primitives，如何加，加在代码的何处，还请您帮助，谢谢！！！还有这句
"kk: 2*(FF+DDA)" 'FFS写错了为FF
这句是不是也用此方法，谢谢！！！

Answer 15

问题就是看不懂12楼的描述。
EvaluateExpr("AAA(N,5)-AAA(N,7)") 为什么要反复执行？
执行完一次就可以加了Primitives.Add HXTSJ2(0).VarArr(I), "FF"

Answer 16

FOR I= 1 TO 13 
HXTSJ2(0).VarArr(I)=EvaluateExpr("AAA(N,5)-AAA(N,7)") 
Primitives.Add HXTSJ2(0).VarArr(I), "FF"'提示要求对象 
NEXT 其实我想要操作的是数组操作，("AAA(N,5)-AAA(N,7)") 中，N为一个数组AAA(N,5)也是得到一个数组("AAA(N,5)-AAA(N,7)") 这就是两个数组之间的相减，我不会操作，就把他先单个计算，再循环付给HXTSJ2(0).VarArr(I)我的描诉您能看懂吗，要是直接用纸个函数操作数组能行吗，谢谢！！！'Private Function aaa(CLOSEE() As Long, DAT As Integer) As Single()
'ReDim HTEM(1 To UBound(CLOSEE)) As Single
'For i = 1 To UBound(CLOSEE)
'     If i = 1 Then
'     HTEM(i) = 0
'     Else
'        If i = 2 Then
'        LODSJ = CLOSEE(1)
'        End If
'        HTEM(i) = (2 * CLOSEE(i) + (DAT - 1) * LODSJ) / (DAT + 1)
'        LODSJ = HTEM(i)
'     End If
'Next
'aaa = HTEM()
'End FunctionPublic Function N() As Long()
'Dim i&
'ReDim hTmp(1 To UBound(hq) - 1) As Long
'For i = 1 To UBound(hq) - 1
'hTmp(i) = hq(i)
'Next
'N= hTmp
'Erase hTmp
'End Function

Answer 17

TO Tiger_Zhao:
我知道Primitives.Add HXTSJ2(0).VarArr(I), "FF"错哪了
Set Primitives = New Collection
但是
FOR I= 1 TO 13 
HXTSJ2(0).VarArr(I)=EvaluateExpr("AAA(N,5)-AAA(N,7)") 
Primitives.Add HXTSJ2(0).VarArr(I), "FF"'提示“该关键字以与该集合一个元素相关联”
NEXT 
这个问题该如何解决，谢谢！！！

Answer 18

数组-数组 我想到可以再作一个过程但2*(FF+DDA)" 这个可能有问题，我重新开一新贴，还请您帮助，谢谢！！！