直接上代码,后面有时间再来补说明。

——————————-
synaxAnalyze类
——————————-

Option Explicit
Option Base 1 '指定数组下标从1开始
  Private p_rs() As syntaxUnit
  Private p_rs_Inited As Boolean
   
  
  
  Public Function rs() As syntaxUnit
    Set rs = p_rs
  End Function
  
Public Property Get ss()
 Dim i, result
 result = ""
 For i = 1 To UBound(p_rs)
  result = result & IIf(result = "", "", ",") & p_rs(i).name
 Next
 ss = result
End Property


'公式转换为SQl语句,纯循环方式放入数组rs
'参数:fm 待进行分析的字串
Public Sub Analyze(ByVal fm As String)
Dim delimiter, optStr, length, i, curr_char, next_string, vstr, newLength
Dim r As syntaxUnit
Dim s_stack As synaxStack
optStr = "+-*/!^<>=" '操作符
delimiter = "()[]{}" '定界符
Dim blankReg As RegExp
Set blankReg = CreateObject("VBScript.RegExp")
blankReg.Pattern = "\s"
blankReg.Global = True

length = Len(fm)
vstr = ""
Set s_stack = New synaxStack

For i = 1 To length Step 1
    curr_char = Mid(fm, i, 1)
    
    If InStr(1, optStr, curr_char) > 0 Then
    '发现运算操作符,左边部分存入节点名称
        If Not p_rs_Inited Then
            newLength = 1
            p_rs_Inited = True
        Else
            newLength = UBound(p_rs) + 1
        End If
     
      ReDim Preserve p_rs(newLength)
      
      If Len(vstr) > 0 Then 'vstr有字符
            If blankReg.Test(Trim(vstr)) > 0 Then
              MsgBox "发现语法错误:变量会函数名称中含有空格,请检查。位置:" & i
              Class_Terminate
              Exit Sub
            End If
            If IsNumeric(vstr) Then  '数字
                r.name = vstr
                r.type = constant
                r.start = i - Len(vstr)
                r.end = i
                p_rs(newLength) = r
            Else
                r.name = vstr
                r.type = variable
                r.start = i - Len(vstr)
                r.end = i - 1
                p_rs(newLength) = r
            End If
            newLength = UBound(p_rs) + 1 '增加一个单元
            ReDim Preserve p_rs(newLength)
      End If
    r.name = curr_char
    r.type = opt
    r.start = i - 1
    r.end = i
    p_rs(newLength) = r
      
     vstr = ""
    ElseIf InStr(1, "([", curr_char) > 0 Then
    '发现左括号,存入
        s_stack.push curr_char
        
        If Not p_rs_Inited Then
            newLength = 1
            p_rs_Inited = True
        Else
            newLength = UBound(p_rs) + 1
        End If
        ReDim Preserve p_rs(newLength)
        If Len(vstr) > 0 Then 'vstr有字符
            If blankReg.Test(Trim(vstr)) > 0 Then
              MsgBox "发现语法错误:变量会函数名称中含有空格,请检查。位置:" & i
              Class_Terminate
              Exit Sub
            End If
            
            If IsNumeric(vstr) Then  '数字
                r.name = vstr
                r.type = constant
                r.start = i - Len(vstr)
                r.end = i
                p_rs(newLength) = r
            Else
                r.name = vstr
                If curr_char = "(" Then '带左括号时,左边字符串为函数名称,否则为变量名称
                r.type = fnName
                Else
                r.type = variable
                End If
                
                r.start = i - Len(vstr)
                r.end = i
                p_rs(newLength) = r
            End If
            newLength = UBound(p_rs) + 1 '增加一个单元
            ReDim Preserve p_rs(newLength)
        End If
        
        r.name = curr_char
        r.type = childUnitStart
        r.start = i - 1
        r.end = i
        p_rs(newLength) = r
      vstr = ""
    ElseIf InStr(1, ")]", curr_char) > 0 Then
    '发现右括号
         If (s_stack.top = "(" And curr_char = ")") Or (s_stack.top = "[" And curr_char = "]") Then
           s_stack.pop
         Else
            MsgBox "发现语法错误:右括号不匹配,请检查。位置:" & i
            Class_Terminate
           Exit Sub
         End If
        If Not p_rs_Inited Then
            newLength = 1
            p_rs_Inited = True
        Else
            newLength = UBound(p_rs) + 1
        End If
        ReDim Preserve p_rs(newLength)
        If Len(vstr) > 0 Then 'vstr有字符
        
           If blankReg.Test(Trim(vstr)) > 0 Then
              MsgBox "发现语法错误:变量会函数名称中含有空格,请检查。位置:" & i
              Class_Terminate
              Exit Sub
            End If
            If IsNumeric(vstr) Then  '数字
                r.name = vstr
                r.type = constant
                r.start = i - Len(vstr)
                r.end = i
                p_rs(newLength) = r
            Else
                r.name = vstr
                r.type = variable
                r.start = i - Len(vstr)
                r.end = i
                p_rs(newLength) = r
            End If
            newLength = UBound(p_rs) + 1 '增加一个单元
            ReDim Preserve p_rs(newLength)
        End If
        
        r.name = curr_char
        r.type = childUnitEnd
        r.start = i - 1
        r.end = i
        p_rs(newLength) = r
         vstr = ""
    Else
    vstr = vstr & curr_char
    End If
Next
If Len(vstr) > 0 Then
    If Not p_rs_Inited Then
            newLength = 1
        Else
            newLength = UBound(p_rs) + 1
        End If
    ReDim Preserve p_rs(newLength)
    If IsNumeric(vstr) Then  '数字
       r.name = vstr
       r.type = constant
       r.start = i - Len(vstr)
       r.end = i
       p_rs(newLength) = r
    Else
       r.name = vstr
       r.type = variable
       r.start = i - Len(vstr)
       r.end = i
       p_rs(newLength) = r
    End If
End If
If s_stack.length <> 0 And s_stack.top <> "" Then
    Class_Terminate
    MsgBox "发现语法错误:缺少与左括号项匹配的右括号, 请检查。左括号位置:" & s_stack.length
End If
End Sub




'初始化
Private Sub Class_Initialize()
   'ReDim p_rs(0)
   p_rs_Inited = False
End Sub


'销毁,撤出资源占用
Private Sub Class_Terminate()
  Erase p_rs
End Sub

———————–
synaxStack类
———————–

Option Explicit
'语法栈类
Option Base 1 '指定数组下标从1开始

Private p_stack() As String
Private isInit As Boolean

'弹出一个元素
Public Sub pop()
If length = 1 Then
  p_stack(1) = ""
  isInit = False
Else
 ReDim Preserve p_stack(length - 1)
End If
End Sub

'压入一个元素
Public Sub push(v)
    If Not isInit Then
     ReDim Preserve p_stack(1)
     isInit = True
    Else
     ReDim Preserve p_stack(length + 1)
    End If
    p_stack(length) = v
End Sub

'获取栈高度(长度)
Public Property Get length()
length = UBound(p_stack)
End Property


'获得栈顶元素
Public Property Get top()
top = p_stack(length)
End Property

Private Sub Class_Initialize()
    'ReDim p_stack(1)
    isInit = False
End Sub

'销毁,撤出资源占用
Private Sub Class_Terminate()
 Erase p_stack
End Sub

———————–
语法单元类型
———————–

Public Type syntaxUnit
 name As String '名称
 type As syntaxType '类型
 start As Integer '开始位置
 end As Integer '结束位置
End Type

Public Enum syntaxType
 opt = 0 '操作符
 fnName = 1 '函数或子过程
 variable = 2 '变量
 constant = 3 '常量
 childUnitStart = 4 '子单元开始
 childUnitEnd = 5 '子单元结束
End Enum