OpenOffice.info

Code: Alles auswählen

REM  *****  BASIC  *****

Option VBASupport 1
Option Explicit

Private Enum eTokens
   k_CONST = 257  ' eine Zahl
   k_DONE         ' Ende
End Enum

Private strInput As String     ' Der zu parsende Eingabestring
Private intNext As Integer     ' Index des nächsten zu lesenden Zeichens
Private lookahead As Integer   ' Das nächste Token
Private Numval As Double       ' der Wert einer Konstanten

Public Sub ParseIt()
   Dim i As Long
   
   For i = 1 To ActiveSheet.UsedRange.Rows.Count
      Cells(i, 2) = Evaluate(Cells(i, 1).Value)
   Next
End Sub

Public Function Evaluate(ByVal s As String) As Double ' die oberste Stufe des Parsers
   intNext = 0
   strInput = s
   lookahead = lexan()
   Evaluate = Expr()
End Function

Private Function Expr() As Double
   Dim myVal As Double
   
   myVal = Term()
   While True
      Select Case lookahead
         Case Asc("+")
            match Asc("+")
            myVal = myVal + Term()
         Case Asc("-")
            match Asc("-")
            myVal = myVal - Term()
         Case Else
            Expr = myVal
            Exit Function
      End Select
   Wend
End Function

Private Function Term() As Double
   Dim myVal As Double
   
   myVal = Factor()
   While True
      Select Case lookahead
         Case Asc("*")
            match Asc("*")
            myVal = myVal * Factor()
         Case Asc("/")
            match Asc("/")
            myVal = myVal / Factor()
         Case Asc(":")
            match Asc(":")
            myVal = myVal / Factor()
         Case Else
            Term = myVal
            Exit Function
      End Select
   Wend
End Function

Private Function Factor() As Double
   Select Case lookahead
      Case Asc("(")
      	 match Asc("(")
      	 Factor = Expr()
      	 match Asc(")")
      Case Asc("-")
      	 match Asc("-")
      	 Factor = -Term()
      Case k_CONST
         Factor = Numval
         match k_CONST
	  Case k_DONE
	  	Factor = 0
      Case Else
         MsgBox "Falscher Ausdruck"
         End
   End Select
End Function

Private Function lexan() As Integer   ' die lexikalische Analyse
   Dim ch As String
   
   While True
      intNext = intNext + 1
      ch = Mid(strInput, intNext, 1)
      If ch = " " Or ch = vbTab Then
         ' do nothing
      ElseIf IsDigit(ch) Then
         Numval = Val(Replace(Mid(strInput, intNext), ",", "."))
         While IsNumChar(ch)
            intNext = intNext + 1
            ch = Mid(strInput, intNext, 1)
         Wend
         intNext = intNext - 1
         lexan = k_CONST
         Exit Function
      ElseIf ch = "" Then
         lexan = k_DONE
         Exit Function
      Else
         lexan = Asc(ch)
         Exit Function
      End If
   Wend
End Function

Private Function match(ByVal tok As Integer) As Integer ' Minimaler Test und den nächsten Token lesen
   If lookahead = tok Then
      lookahead = lexan()
   Else
      MsgBox "Error in match"
      End
   End If
End Function

Private Function IsDigit(ByVal ch As String) As Boolean
   IsDigit = ch Like "[0-9]"
End Function

Private Function IsNumChar(ByVal ch As String) As Boolean
   IsNumChar = ch Like "[0-9,]"
End Function

Code: Alles auswählen

=EVALUATE(A1)

Code: Alles auswählen

=EVALUATE("5,5:2")